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THE  GEOLOGIC  RETRIEVAL  AND  SYNOPSIS  PROGRAM  (GRASP) 


By  Roger  W.  Bowen  and  Joseph  Moses  Botbol 


ABSTRACT 

The  Geologic  Retrieval  and  Synopsis  Program  (GRASP) 
was  designed  and  written  to  specifically  accommodate  inter- 
active access  to  earth-science  data  banks.  GRASP  is  portable, 
easy  to  use,  and  data-base  independent. 

Data  banks  accessed  by  GRASP  must  be  partitioned  and 
reformatted  into  five  files  which  make  up  both  data  bank  and 
pointers  to  parts  of  the  bank.  Machine  dependencies  include 
FORTRAN  I/O  unit  numbers,  direct- ( random-)  access  input, 
in-core  read/write,  and  "prompting."  GRASP  isolates  these 
dependencies  to  FORTRAN  subroutines  designed  to  serve 
these  functions  specifically.  GRASP  is  manipulated  by  11  user 
commands  which  select,  describe,  access,  retrieve,  summarize, 
and  display  data. 


INTRODUCTION 

The  U.S.  Geological  Survey  presently  has  the  re- 
sponsibility of  developing  and  maintaining  resource- 
data  banks.  Initially,  many  storage  and  retrieval 
systems  were  critically  reviewed  for  their  data-bank 
characteristics,  ease  of  use,  flexibility,  portability, 
and  applicability  to  Survey  activity.  The  authors  con- 
cluded that  no  available  system  was  wholly  adequate 
for  the  needs  of  the  Survey  data  banks.  Generally, 
the  observed  systems  were  difficult  to  use,  machine 
bound,  or  were  oriented  toward  one  type  of  data 
(for  example,  text  oriented).  The  only  logical  al- 
ternative was  to  design,  develop,  and  implement  a 
geologic-data  storage  and  retrieval  system  to  be 
used  primarily  by  geologists. 

PURPOSE  AND  SCOPE 

The  Geologic  Retrieval  and  Synopsis  Program 
(GRASP)  was  written  to  provide  a  means  of  in- 
teractive access  to  geologic  data  stored  in  a  time- 
sharing computer. 

GRASP  can  be  implemented  on  any  time-sharing 
computer  system  that  has  a  FORTRAN  IV  com- 
piler. Data  bases  accessed  by  GRASP  must  con- 
tain fixed  field  data  in  alphameric,  alphanumeric, 
and/or  numeric  modes. 


GENERAL  SYSTEM  DESCRIPTION 

To  obtain  a  broad  overview  of  the  GRASP  sys- 
tem, consideration  should  first  be  given  to  the 
philosophy  governing  the  design  of  the  system,  use 
of  the  present  system,  and  future  system  plans. 
This  overview  provides  the  "framework"  and  the 
anticipated  "operational  environment"  which  are 
necessary  for  the  development  of  any  system.  Both 
the  present  utilization  and  future  system  plans 
show  the  correctness  of  the  parameters  and  tech- 
niques used  as  well  as  the  original  assumptions  re- 
garding "how,"  "by  whom,"  and  "where"  the  sys- 
tem will  be  used. 

DESIGN  PHILOSOPHY 

Three  vital  questions  that  must  be  answered  prior 
to  the  implementation  of  any  system  are:  (1)  On 
what  computer (s)  will  this  system  be  used?  (2) 
What  are  the  characteristics  of  the  data  to  be  proc- 
essed? (3)  Who  will  use  the  system?  As  is  the  case 
in  many  computer-system  applications,  these  ques- 
tions originally  had  no  definite  answers.  A  3-month 
effort  was  necessary  to  establish  criteria  that  would 
govern  GRASP  design. 

MACHINE  PORTABILITY 

To  serve  as  broad  a  spectrum  of  the  scientific 
community  as  possible,  a  system  should  be  as  port- 
able as  possible.  Because  of  differences  in  computer 
design,  no  system  can  be  used  on  all  computers  with- 
out some  modification.  ANSI  FORTRAN  IV  is  uni- 
versally accepted  as  a  standard  programming  lan- 
guage. It  may  be  used  on  the  vast  majority  of  pres- 
ent-day computers  that  have  the  capacity  for  imple- 
menting compiler-level  languages  in  a  time-sharing 
mode  of  operation.  For  this  reason,  all  the  process- 
ing subroutines  in  GRASP  are  written  in  ANSI 
FORTRAN  IV  (machine-dependent  features  iso- 
lated to  facilitate  implementation).  In  this  way, 
GRASP  can  be  installed  on  virtually  any  modern 
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time-sharing  computer.  By  designing  GRASP  to  be 
portable,  a  much  wider  spectrum  of  the  scientific 
community  can  be  served  by  the  system.  Data  need 
not  be  transferred  from  their  resident  banks  in 
order  to  be  accessed.  GRASP  could  be  used  on  most 
computers  in  order  to  access  data  files  wherever 
they  may  reside.  This  machine  independence  elimi- 
nates the  need  for  tedious  data  transformations  to 
one  system  configuration,  where  the  aggregating 
data  eventually  flood  to  the  point  of  uselessness  the 
peripheral  storage  of  a  central  machine-dependent 
data  bank.  The  authors  believe  that  a  common  ac- 
cessing system  for  data  residing  in  different  com- 
puters is  preferable  to  an  accessing  system  that  can 
be  used  for  data  resident  in  only  one  computer. 

DATA-BASE  INDEPENDENCE 

GRASP  is  designed  to  operate  using  any  data  base 
that  can  be  represented  in  conventional  matrix 
form.  In  matrix  form,  the  records  (that  is,  items  to 
be  described)  are  the  rows,  and  the  attributes  of 
each  record  are  the  columns.  The  real  structure  of 
the  data  base  can  be  thought  of  as  the  titles  and 
arrangement  of  the  columns  of  a  data  matrix  where 
the  rows  are  merely  instances  or  occurrences  de- 
scribed by  the  columns.  For  example,  a  geochemical 
data  base  would  have  a  matrix  representation  in 
which  the  columns  might  represent  chemical  anal- 
yses of  various  elements,  and  each  row  would  rep- 
resent one  sample.  GRASP  can  function  on  any 
data  matrix.  The  only  requirement  is  that  the  vari- 
ables (or  columns)  be  defined  ahead  of  time  in 
terms  of  their  types  (that  is,  alpha  or  numeric), 
and,  where  necessary,  dictionaries  of  legitimate  al- 
phameric entries  must  be  provided  for  alphameric 
variables.  Thus,  because  of  the  matrix  orientation 
of  GRASP,  any  fixed  field  data  base  can  be  ac- 
commodated by  the  system. 

USER  COMMUNITY 

GRASP  is  a  retrieval  system  having  its  own  rules 
and  command  language  for  operation.  In  other 
words,  to  use  GRASP,  the  user  does  not  need  to  be 
familiar  with  FORTRAN  or  any  other  computer 
language.  The  GRASP  command  language  is  de- 
signed to  provide  users  with  the  ability  to  ask  ques- 
tions of  a  data  base  and  retain  all  items  that  an- 
swer "true"  to  the  questions.  The  control  language 
used  to  ask  the  questions  (discussed  in  the  section 
on  "Use  of  GRASP"  in  this  report)  allows  "retrieve 
only"  data  access  to  any  GRASP  user  and  does  not 
require  prior  user  knowledge  of  computer  languages 


or  system  functions.  Thus,  GRASP  can  be  imple- 
mented for  a  wide  variety  of  users. 

TIME  SHARING 

Inasmuch  as  GRASP  is  portable,  data-base  in- 
dependent, and  serves  a  wide  variety  of  users, 
GRASP  should  be  implemented  in  a  computational 
mode  that  has  the  most  readily  available  user  ac- 
cess, namely,  time  sharing.  In  its  simplest  form, 
time  sharing  allows  any  user  to  communicate  with 
the  computer  from  a  terminal  near  a  telephone.  The 
entire  design  of  GRASP  is  based  on  the  premise 
that  the  user  community  will  converse  directly  with 
a  computer  (via  a  terminal)  in  order  to  access,  re- 
trieve, manipulate,  summarize,  and  display  data. 
This  mode  of  computation  provides  the  "instant" 
response  necessary  for  timely  decisionmaking,  and 
also  allows  access  by  the  user  from  the  environment 
in  which  the  computer  response  is  of  most  value,  that 
is,  the  laboratory,  field,  office,  or  conference  room. 

PRESENT  UTILIZATION 

In  1975,  the  GRASP  system  was  being  used  to  ac- 
cess data  from  six  totally  different  data  banks:  (1) 
oil-  and  gas-pool  characteristics  of  Colorado,  (2) 
mineral  deposits  of  the  world,  (3)  geochemical  ex- 
ploration data  from  the  United  States,  (4)  coal  re- 
sources of  the  United  States  (prototypic  data  bank) , 
(5)  index  of  U.S.  geologic  map  coverage  (prototypic 
system),  and  (6)  geothermal  data  bank  (in  Pisa, 
Italy).  The  first  three  of  the  above  systems  were 
implemented  directly  by  the  authors,  and  no  attempt 
was  made  to  redesign  any  of  the  original  data-bank 
structures. 

COLFIL 

This  file  contains  as  many  as  390  characteristics 
for  each  of  800  oil  and  (or)  gas  pools  in  Colorado. 
This  file  served  as  the  original  model  for  GRASP 
design  and  ultimately  will  contain  60,000  records. 

MANFIL 

The  mineral  deposits  of  the  world  (MANFIL) 
were  the  second  file  implemented  using  GRASP.  It 
is  a  computerized  batch-processing-oriented  file  con- 
taining geologic,  production,  and  reserves  data  from 
about  4,000  nonferrous  metal  deposits  throughout 
the  world.  Each  record  represents  one  deposit,  and 
contains  as  many  as  250  variables.  Although  GRASP 
was  designed  using  the  oil-  and  gas-pool  file  as  a 
model,  implementation  of  the  world-mineral-de- 
posits file  showed  the  flexibility  of  GRASP  with  re- 
spect to  its  data-base  independence. 
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RASS 

The  RASS  (Rock  Analysis  Storage  System)  file 
is  a  batch-oriented  geochemical  data  bank  contain- 
ing limited  geologic  descriptions  and  comprehensive 
geochemical  analyses  of  all  samples  processed  by  the 
laboratories  of  the  U.S.  Geological  Survey.  This  file 
contains  a  unique  type  of  numeric  data  called  "quali- 
fied values."  Because  of  the  upper  and  lower  de- 
tectability  limits  of  analytic  devices,  elements  whose 
presence  is  known  but  whose  content  is  outside  the 
analytical  range  of  a  device  are  sometimes  reported 
at  a  given  analytical  cutoff  value,  accompanied  by  a 
letter  indicating  whether  the  content  is  less  than, 
greater  than,  or  in  interference  with  another  ele- 
ment. Typical  qualified  entries  would  appear  as 
L5000,  G1000,  or  H100,  where  L  signifies  a  content 
less  than  the  attached  value,  G  signifies  a  content 
greater  than  the  attached  value,  and  H  signifies 
analytical  interference  at  a  concentration  of  the  at- 
tached value.  Because  many  of  the  RASS  data  were 
accompanied  by  alpha  qualifiers,  GRASP  was  modi- 
fied to  accept  and  process  this  type  of  data  in  addi- 
tion to  the  conventional  numeric-  and  alphameric- 
data  types. 

All  the  above  files  are  implemented  in  a  retrieve 
mode  only,  and  graphics  have  not  yet  been  added. 
Input  to  the  files  is  done  by  people  who  are  respon- 
sible for  data  entry  and  does  not  fall  in  the  domain 
of  the  user. 

FUTURE  PLANS 

Currently,  the  development  of  GRASP  is  primar- 
ily oriented  toward  implementation  of  techniques 
for  interactive  graphics  storage  and  retrieval.  Three 
problem  areas  are  presently  being  researched :  auto- 
matic recognition  of  features  on  scanned  input  docu- 
ments, annotation  methods,  and  resolution  of  "in- 
tersecting feature"  problems.  Present  research  ef- 
forts are  directed  toward  feature  recognition  and 
subsequent  computational  extraction  of  simple 
boundary  vectors  from  scanned  digital  maps  and 
photographs.  In  addition  to  recognition  of  features, 
methods  are  also  being  developed  for  annotation  of 
both  graphics-data  entry  and  presentation  of 
graphics  data  on  output. 

One  of  the  major  anticipated  technical  and  philo- 
sophical problems  is  concerned  with  the  graphical 
resolution  of  intersecting  features.  Techniques  are 
being  developed  that  should  resolve  these  problems 
for  any  particular  data  set. 

All  the  GRASP  graphics  output  is  being  designed 
primarily  for  interactive  graphics  cathode  ray  tube 


(CRT)  representation.  This  is  in  keeping  with 
GRASP's  original  "totally  interactive"  design  philo- 
sophy. 

DETAILED  SYSTEM  DESCRIPTION 

GRASP  is  designed  as  a  highly  modular,  hier- 
archically structured  set  of  subroutines  (see  section 
"GRASP  Software  Specifications").  Each  subrou- 
tine performs  a  fixed  task.  The  higher  level  sub- 
routines are  primarily  concerned  with  the  flow  of 
control  required  to  execute  a  user  command.  The 
lower  level  subroutines  are  primarily  concerned  with 
extremely  independent  and  specific  tasks  (such  as 
"get  a  record,"  "access  a  dictionary,"  and  "accept 
user  input,"  and  so  on).  All  information  related  to 
a  specific  data  base  is  obtained  from  various  files 
associated  with  that  data  base.  Structuring  the  sys- 
tem in  this  way  leads  to  a  high  degree  of  functional 
isolation.  These  design  characteristics  simplify  the 
development,  documentation,  maintenance,  growth, 
and  inevitable  change  inherent  in  a  system  that  sup- 
ports a  variety  of  data  bases  on  a  wide  spectrum  of 
computer  main  frames.  The  section  on  GRASP  soft- 
ware specifications  is  intended  for  use  by  those  fa- 
miliar with  FORTRAN  language. 

DATA-FILE  STRUCTURES 

Upon  initial  execution,  the  GRASP  system  reads 
an  "index"  file  which  contains  the  names  of  data 
bases  available  for  access.  Each  record  of  the  index 
file  corresponds  to  a  data  base  and  contains  the 
names  of  the  files  associated  with  that  data  base 
and  a  40-character  description  of  the  data  base. 

Each  data  base  is  composed  of  five  files  which  con- 
tain the  actual  data,  information  on  the  structure 
of  records,  names  which  will  be  used  to  refer  to  par- 
ticular items  within  records,  descriptive  information 
on  the  names  themselves,  and  a  grouping  into  cate- 
gories of  information.  These  files  are  called  Mask, 
Definitions,  Dictionary,  Multiple-choice,  and  Nu- 
meric Master  files. 

MASK  FILE 

The  Mask  file  contains  the  item  names,  item  types 
(integer,  real,  character  string,  multiple  choice,  and 
qualified  real),  and  pointers  to  the  first  entry  in  the 
Dictionary  file  for  each  character-type  item.  This 
file  is  read  once  and  rewound  when  a  data  base  is 
selected  via  the  FILE  command.  An  example  of 
Mask  file  arrangement  is  shown  in  figure  1. 
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Conceptual   noncomputerized  dictionaries 
for  three  character  type  variables: 

Variable  No.  1     Variable  No.  2      Variable  No.  3 
Continent  Country  Province  (State) 


North  America 

USA 

California 

South  America 

Canada 

Virginia 

Europe 

Mexico 

British  Columbia 

Argentina 

Quebec 

Brazil 

Cordova 

Chile 

V 

Germany 

In  the  computer,  the  MASK  File  is  arranged  as  follows: 
Mask  File 


Variable  Name 

Variable  Type 

Starting  Position  in 
Dictionary  File 

Continent 

Character 

1 

Country 

Character 

4 

Province  (State) 

Character 

11 

Production 

Numeric,  real 

* 

*Note:  This  variable  is  numeric,  and  does 
not  require  a  pointer  to  the 
Dictionary  File 


In  the  computer,  the  Dictionary  File 
is  arranged  as  follows: 


Dictionary  File 

Item  No.    Pointer  to 
next  item 


Name 


10 


11 


12 


13 


14 


15 


10 


12 


13 


14 


15 


ii 


North  America 


South  America 


Europe 


USA 


Canada 


Mexico 


Argentina 


Brazil 


Chile 


Germany 


California 


Virginia 


British  Columbia 


Quebec 


Cordova 


("0"  indicates  end 
of  list  for  particular 
variable) 


Figure  1. — Example  of  Mask-file  and  Dictionary-file  arrangement. 


DEFINITIONS  FILE 

The  Definitions  file  contains  the  following  infor- 
mation : 

1.  The  number  of  categories  in  the  file. 

2.  The  maximum  number  of  (computer)  words  in 

a  category  name. 

3.  The  category  names. 

4.  For  each  category  the  following  information  is 

recorded : 

(a)   category  number. 

number  of  lines  used  to  describe  this  cate- 


(b) 
(c) 
(d) 

(e) 


gory. 

maximum  length  (in  computer  words)  of 
a  description  in  this  category. 
number  of  variables  appearing  in  this 
category.  In  some  cases  this  will  be  dif- 
ferent from  item  b  (the  number  of  lines 
for  description). 

indices  of  the  variables  appearing  in  this 
category. 


(f)   the  variable  names,  types,  and  descrip- 
tions for  this  category. 

DICTIONARY  FILE 

The  Dictionary  file  contains  all  character-string 
values  which  are  assumed  by  character-type  items. 
Each  record  contains  a  pointer  to  the  record  con- 
taining the  next  value,  followed  by  the  current  value. 
The  last  value  assumed  by  a  character-type  item  is 
indicated  by  a  pointer  value  of  zero  (the  record 
containing  the  first  character-string  value  for  a 
character-type  item  is  pointed  to  by  a  value  in  the 
Mask  file) .  The  Dictionary  file  is  designed  as  a  ran- 
dom-access file  whose  values  form  a  linked  list.  Fig- 
ure 1  shows  an  example  of  the  Dictionary-file  ar- 
rangement. 

MULTIPLE-CHOICE  FILE 

The  Multiple-choice  file  contains  the  acronyms  and 
acronym  meanings  for  the  values  assumed  by  mul- 
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tiple-choice  items.  Each  record  of  this  file  is  com- 
posed of  an  item  number  indicating  the  multiple- 
choice  item,  the  number  of  possible  values  this  item 
assumes,  the  maximum  length  of  an  acronym  value 
description,  and  a  list  of  acronyms  (which  are 
double  words)  and  their  descriptions. 

NUMERIC  MASTER  FILE 

The  Numeric  Master  file  is  composed  of  the  rec- 
ords for  a  data  base  in  a  compressed  form.  Values 
for  integer-type  items  are  stored  as  integers.  Values 
for  floating-point-  (or  real-)  type  items  are  stored 
as  real  numbers.  Values  for  character-type  items  are 
stored  as  integer  pointers  to  the  entry  number  in 
the  Dictionary  file.  Values  for  multiple-choice-type 
items  are  stored  as  integers  containing  a  binary  en- 
coding that  represents  the  value  set.  (For  example, 
if  the  second  and  fifth  bit  of  the  word  are  "on,"  the 
value  assumed  is  the  second  and  fifth  acronym 
value.)  Each  record  of  the  compressed  Master  file 
is  variable  length  in  form  and  corresponds  to  an  ex- 
panded 400-word  record.  Expansion  of  the  com- 
pressed record  is  performed  by  subroutine  GET- 
PUT.  Figure  2  shows  an  example  of  the  Numeric 
Master  file  prior  to  compression. 


DATA   COMPRESSION 

The  compression  technique  used  is  a  form  of 
blank  suppression.  The  words  of  the  compressed 
record  are  one  of  the  following  four  types : 

A.  Integer  value. 

B.  Real  value. 

C.  Integer  blank  count. 

D.  Integer  word  count. 

The  first  word  of  all  records  is  of  type  D  (above) 
and  is  used  to  give  the  length  of  the  record.  Subse- 
quent words  may  be  types  A,  B,  and  C.  For  types  A 
and  C,  the  last  two  bits  give  the  type  of  the  next 
word.  The  value  of  the  word  is  obtained  by  divid- 
ing by  4.  The  type  of  the  next  word  is  obtained  via 
the  remainder  modulo  4,  where  the  numbers  1-3 
correspond  to  types  A,  B,  and  C.  Type-A  words  are 
used  for  numeric  integers,  pointers  to  entries  in 
character  dictionaries,  and  binary  encodings  of  mul- 
tiple-choice-type items.  Type-C  words  are  used  to 
count  the  number  of  consecutive  blanks  to  be  in- 
serted in  the  expanded  record.  Type-B  words  are 
used  for  floating-point  numeric  values.  The  type  of 
the  next  word  is  contained  in  the  last  2  bits  of  the 
whole  (integer)  part  of  the  words.  For  example, 
consider  a  data  word  having  a  value  of  49.723.  The 


Given  the  following  two  successive  noncomputerized  records  to  be  entered  into  the  Numeric  Storage  File: 

Record  1  Record  2 

Continent 

Country 

Production 

Identification  No. 

Province  (or  State) 


North  America 

South  America 

United  States 

Argentina 

39281.6 

49298.7 

38 

39 

Virginia 

Cordova 

Prior  to  compression,  the  computerized  Numeric  Storage  File  is  arranged  as  follows: 


Continent* 

Country* 

Production 

ID  No. 

Province* 

etc 

1 

1 

39281.6 

38 

2 

2 

4 

49298.7 

39 

5 

'See  figure  1— for  dictionary  codification  of  continent,  country,  and  province 


Figure  2. — Example  of  Numeric-Master-file  arrangement  prior  to  compression. 
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floating-point  value  would  be  12.723  (12  =  49/4), 
and  the  type  of  the  next  word  would  be  49-  (4x 
12)=  lor  A. 

MACHINE  DEPENDENCIES 

Although  most  of  the  GRASP-system  code  is 
written  in  ANSI  FORTRAN  IV,  certain  isolated 
functions  must  be  tailored  to  the  particular  FOR- 
TRAN compiler  on  any  given  machine.  These  func- 
tions deal  with  the  dynamic  association  of  data  set 
names  and  FORTRAN  I/O  unit  numbers,  direct- 
( random-)  access  input,  the  method  of  accommodat- 
ing "prompting,"  and  internal  (in-core)  transfer 
(writes)  using  format  control. 

For  the  dynamic  association  of  data-set  names 
and  FORTRAN  unit  numbers,  the  routines  IFILE, 
OFILE  and  DEFINE  are  used.  Details  of  these 
routines  can  be  found  in  the  section  "GRASP  Soft- 
ware Specifications." 

Direct-access  input  is  used  to  access  the  Diction- 
ary file  (in  subroutine  ACCESS).  The  FORTRAN 
unit  number,  an  integer  expression  giving  the  record 
number,  and  an  input  list  are  supplied  in  the  READ 
statement.  This  form  of  direct-access  input  is  com- 
patible with  most  FORTRAN  compilers  which  sup- 
port direct-access  input.  Systems  not  having  direct- 
access  capabilities  can  be  accommodated  by  modify- 
ing the  logic  of  this  subroutine.  This  modification 
involves  positioning  of  a  sequential  file  to  the  ap- 
propriate record  prior  to  execution  of  the  READ 
statement. 

For  systems  which  do  not  accept  the  "prompt"  op- 
tion in  the  READ  statement,  user  "prompting"  can 
be  accomplished  by  using  WRITE  statements  im- 
mediately preceding  (in  time)  user  input.  The 
"prompt"  message  is  contained  in  a  FORMAT  state- 
ment, along  with  a  character  which  inhibits  the 
generation  of  the  normal  carriage-return/line-feed 
usually  associated  with  output  directed  to  a  time- 
share  terminal.  If  a  particular  system  does  not  have 
this  capability,  the  "prompting"  message  will  ap- 
pear on  a  separate  line  immediately  preceding  the 
user  input. 

The  internal  transfer  of  data  under  format  con- 
trol is  accomplished  via  the  ENCODE  statement. 
The  ENCODE  statement  is  used  in  subroutine 
COLPNT  to  construct  a  line  of  output.  The  only 
other  use  of  ENCODE  is  in  subroutine  PACK  which 
is  used  to  convert  characters  from  unpacked  to 
packed  form.  Most  non-IBM  FORTRANS  support 
this  statement  in  one  form  or  another.  In  the  case 
of  IBM  FORTRAN,  a  routine  must  be  provided  that 
allows  internal  data  transfer  under  format  control. 


INTERNAL  STRUCTURE  AND  FUNCTIONS 

GRASP  is  designed  to  accept  a  "command"  (or 
directive)  from  the  user.  Once  the  command  has 
been  recognized,  the  appropriate  subroutine  is  exe- 
cuted. This  subroutine  will,  in  most  cases,  call  other 
subroutines  in  order  to  accomplish  its  intended  task. 
In  some  cases  subroutine  calls  are  nested  to  a  depth 
of  six.  Figure  3  gives  a  pictorial  summary  of  the 
calling  hierarchy  for  subroutines  which  are  in 
GRASP.  This  figure  will  be  useful  in  implementing 
or  modifying  the  GRASP  system. 

PROCESSING  USER  INPUT 

All  user  input  to  GRASP  is  passed  to  the  system 
in  unpacked  character  form.  At  the  highest  level 
are  single  words  used  to  execute  a  GRASP  "com- 
mand." In  this  case,  the  characters  are  packed,  and 
the  result  is  compared  to  the  list  of  available  com- 
mands. After  a  command  has  been  issued,  supple- 
mentary user  input  is  usually  required.  This  sup- 
plementary input  must  then  be  "parsed"  (that  is, 
converted)  into  a  form  more  meaningful  to  the 
GRASP  system.  This  parsed  form  is  entirely  nu- 
meric in  nature.  The  numbers  themselves  may  rep- 
resent values,  integer  encodings,  or  pointers.  Sup- 
plementary input  falls  into  five  independent  areas: 
conditional  expressions,  logical  expressions,  number 
lists,  name  lists,  and  arithmetic  expressions. 

CONDITIONAL  EXPRESSIONS 

A  conditional  expression  is  an  attribute  name,  fol- 
lowed by  a  relation,  followed  by  a  value.  The  attri- 
bute name  is  identified  using  the  binary-search 
technique.  The  relation  is  identified  by  a  sequential 
table  lookup.  The  value  is  converted  to  correspond 
in  type  with  the  attribute  name  referenced.  This 
may  result  in  a  pointer  to  a  character  entry  in  the 
Dictionary  file,  a  binary  encoding  of  an  acronym 
value  in  a  record  of  the  Multiple-choice  file,  or  sim- 
ply a  numeric  value.  Each  conditional  expression 
entered  is  associated  with  a  letter  (A-Z). 

LOGICAL  EXPRESSIONS 

Logical  expressions  are  composed  of  letters  refer- 
ring to  conditional  expressions,  the  grouping  sym- 
bols used  to  control  the  order  of  evaluation,  and  the 
logical  operators  .AND.  (*),  .OR.  (  +  ),  .NOT.  (-). 
For  ease  of  evaluation  logical  expressions  are  con- 
verted to  reverse-Polish  form.  This  is  a  parenthesis- 
free  form  which  permits  rapid  evaluation  using  a 
push-down  stack  technique.  For  a  detailed  descrip- 
tion of  the  conversion  to  and  evaluation  of  reverse- 
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SUBROUTINE  NAMES 


w 
< 
w 

H 
D 

O 
x. 

X 


w 
p 

z 

Oh 

o 
u 

72 

Q 

o 
u 

z 

H 
Q 
Z 

O 
U 

Oh 

s 
o 
u 

W 
Q 

H 

72 

w 

Q 

H 

M 

Oh 

P 
Q 

E 

H 

Oh 
hJ 

w 
K 

w 

G 

Oh 

03 
W 

!3 

Oh 

X 

w 

o 
►J 

Z 

< 

w 

<: 

2 

W 
J 

E 
o 

Oh 

w 

Oh 
Oh 
O 

W 
72 

Oh 
< 
Oh 

Oh 
W 

H 

z 

Oh 

5 

0- 
X 

w 
w 

OS 

> 

OS 
H 

w 

QS 

z 

Oh 

o 

OS 

H 
OS 
<! 

H 
72 

72 
> 

72 
U 

E 

< 
> 

ACCESS 

M 

-* 

-* 

M 

-< 

BDEF 

A 

A 

-* 

A 

BFIND 

•^ 

■^ 

•4 

■^ 

BINIT 

•4 

BINTYP 

■< 

•^ 

-4 

A 

•< 

-* 

BLIST 

•4 

•^ 

-< 

COLPNT 

A 

•4 

A 

A 

A 

COMP 

■< 

DECOMP 

-* 

DEFINE 

•* 

DEFLST 

•4 

A 

A 

<« 

DRIVER 

▲ 

▲ 

A 

▲ 

A 

A 

A 

A 

A 

A 

A 

A 

A 

EVAL 

-* 

-* 

FDRIVE 

A 

-4 

A 

FIND 

** 

•* 

FINDGP 

<+ 

A 

< 

GETPUT 

^ 

M 

•^ 

<* 

•^ 

ICONV 

-* 

M 

-* 

IFILE 

-* 

~* 

<* 

•4 

INIT 

•< 

-+ 

KEYBRD 

M 

-^ 

■* 

M 

•4 

-^ 

M 

•* 

-* 

<* 

-* 

•4 

LENGTH 

•+ 

<+ 

-* 

OBEY 

-* 

A 

A 

A 

^ 

M 

OPREP 

-* 

A 

-< 

PACK 

"* 

^ 

-* 

^ 

•* 

•^ 

< 

■< 

«* 

M 

^ 

•< 

PAUSE 

m 

-* 

-* 

A 

<4 

•^ 

PREVAL 

A 

^ 

RELEXP 

<4 

A 

RLIST 

-^ 

-* 

ROWPNT 

•4 

A 

A 

SCAN 

< 

-* 

-* 

UNCODE 

-^ 

-+ 

■^ 

•< 

M 

■< 

■* 

Figure  3. — Pictorial  summary  of  GRASP  subroutine  interrelationships.  The  arrows  point  to  subroutines  that  are  called. 
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Polish  form  expressions,  the  reader  is  referred  to 
Lee  (1967,  p.  162-180). 

NUMBER  LISTS 

Number  lists  are  composed  of  one  or  more  in- 
teger numbers  or  number  ranges  (for  example,  1, 
2-7,  10).  Each  pair  of  elements  in  a  number  list 
must  be  separated  by  a  comma.  Individual  elements 
are  generated  from  the  unpacked  character  form  by 
constructing  each  number,  one  digit  at  a  time,  us- 
ing a  sequential  lookup  on  each  character.  Number 
ranges  are  generated  by  filling  in  the  interior  num- 
bers from  the  pair  of  extremes. 

NAME  LISTS 

Name  lists  are  composed  of  one  or  more  names. 
When  the  name  list  contains  a  single  element  such 
as  a  file  name,  the  packed  form  is  obtained  and  as- 
sociated with  the  appropriate  FORTRAN  unit  num- 
ber. If  the  name  list  is  one  or  more  attribute  names, 
each  pair  of  which  is  separated  by  a  comma,  each 
element  is  packed  and  looked  up  using  the  binary- 
search  technique. 

ARITHMETIC  EXPRESSIONS 

Arithmetic  expressions  may  be  entered  in  the 
place  of  single  attribute  names  as  supplementary 
input  to  the  LIST  command.  These  arithmetic  ex- 
pressions may  be  composed  of  constants,  the  group- 
ing symbols  (  ),  attribute  names,  the  arithmetic 
operators  +,  *,  /,  -,  and  the  functions  square 
(SQR),  square  root  (SQRT),  log  base  10  (LOG) 
and  power  of  10  (EXP).  The  arithmetic  expression 
is  converted  on  input  to  reverse-Polish  form.  Eval- 
uation is  done  on  output.  If  any  of  the  attributes  in 
the  expression  has  no  value  for  a  given  record,  the 
expression  is  not  evaluated.  All  conversion  to  re- 
verse-Polish form  is  done  using  transition-matrix 
parsing.  Bauer  and  Samelson  (1960)  give  a  discus- 
sion of  this  technique. 

SEARCHES 

The  two  general  types  of  GRASP  searches  are  ex- 
ternal file  and  internal  table.  External-file  searches 
are  made  on  the  Dictionary  file,  Multiple-choice  file, 
and  Numeric  Master  file. 

The  Dictionary  file  is  searched  in  two  ways.  The 
first  way  is  as  an  indexed  sequential  file.  When  a  con- 
dition relating  an  attribute  name  to  a  character- 
string  value  is  entered,  the  record  number  of  the 
first  entry  of  the  dictionary  for  that  attribute  is 
obtained  from  the  "unnamed"  common  area.  That 


record  is  read  (directly),  giving  the  entry  value  and 
a  pointer  to  the  record  containing  the  next  entry. 
The  entry  value  is  compared  with  the  character- 
string  value,  and,  if  not  equal,  the  record  containing 
the  next  entry  is  read.  This  process  continues  until 
an  entry  is  found  that  matches  the  character-string 
value,  or  until  all  entries  of  the  dictionary  have  been 
read.  The  latter  condition  is  detected  by  a  next- 
record-pointer  of  zero.  The  second  way  of  searching 
the  Dictionary  file  is  as  a  direct-  (random-)  access 
file.  To  display  the  value  of  a  character-type  at- 
tribute, its  pointer  is  obtained  from  the  current 
record  of  the  selected  Numeric  Master  file  *  and  its 
value  is  obtained  by  a  direct-access  read  on  the 
Dictionary  file. 

Multiple-choice  acronym  values  are  obtained  when 
a  condition  is  entered  involving  a  multiple-choice- 
type  attribute  and  when  the  value  (s)  of  a  multiple- 
choice-type  attribute  is  to  be  displayed.  Each  record 
of  the  Multiple-choice  file  contains  all  the  acronym 
values  for  a  particular  multiple-choice  attribute.  In 
all  cases,  the  Multiple-choice  file  is  read  in  direct- 
( random-)  access  mode  using  a  pointer  from  the 
"unnamed"  common  area.  After  the  correct  record 
has  been  obtained,  the  attribute  values  are  available 
in  a  tabular  (array)  form. 

The  Numeric  Master  file  is  searched  in  a  purely  se- 
quential fashion.  This  search  involves  the  application 
of  a  "question"  to  each  record  of  the  file  where  the 
"answer"  can  only  be  "yes"  or  "no."  If  the  answer  is 
"yes,"  the  record  is  written  on  an  output  file.  The 
question  is  posed  by  previously  entering  conditions 
and  relating  them  by  a  logical  expression. 

Internal  table  searches  are  made  on  attribute 
names  and  single  characters.  All  lookups  on  attri- 
bute names  are  done  using  the  "binary  search"  tech- 
nique on  a  sorted  list.  The  list  of  names  are  read 
and  sorted  by  execution  of  the  FILE  command.  The 
interval  that  possibly  contains  the  desired  name  is 
repeatedly  halved  until  it  is  of  length  one.  At  that 
point,  the  position  of  the  name  is  known,  or  the 
name  is  not  in  the  list. 

Single  characters  are  looked  up  sequentially  when 
the  list  of  possibilities  is  short,  as  in  the  case  of 
digits  in  a  number.  A  "hash  code"  technique  is 
applied  for  longer  lists  such  as  alphabetic  letters. 
This  technique  involves  the  initial  storage  of  possi- 
bilities in  a  position  dictated  by  a  function  applied 
to  the  value  itself.  This  is  done  in  a  table  whose 
size  is  greater  than  the  number  of  possibilities.  If 


1  The  selected    Numeric    Master   file   most   probably   will    be   some   retrieved 
subset  of  the   true  Numeric    Master  file. 


DATA-BASE  IMPLEMENTATION 


the  position  is  already  occupied,  an  additional  func- 
tion is  applied  to  the  value  until  an  unoccupied 
position  is  found.  Once  the  possibilities  have  been 
stored  in  this  manner,  the  lookup  of  an  arbitrary- 
character  is  accomplished  by  applying  the  same  pro- 
cedure. If  an  empty  position  is  detected  during  look- 
up, the  character  is  not  in  the  list.  Bell  and  Kaman 
(1970)  give  a  more  detailed  description  of  the  tech- 
nique. 

OUTPUT 

A  data-retrieval  system  designed  for  interactive 
use  should  provide  the  user  with  information  re- 
garding use  of  the  system,  the  structure  and  con- 
tent of  a  particular  data  base,  and  the  capability  of 
displaying  selective  attribute  values  for  records  of 
some  partition  of  a  data  base.  These  capabilities 
have  been  incorporated  in  GRASP  and  are  individ- 
ually discussed  in  the  following  paragraphs. 

Information  regarding  use  of  the  GRASP  system 
is  provided  in  two  ways.  First,  all  user  response  is 
preceded  by  system-generated  "prompts"  which 
indicate  the  type  of  response  desired.  Secondly,  a 
command  (HELP)  has  been  implemented  that  gives 
the  user  a  brief  description  of  each  command  rec- 
ognized by  the  system. 

Information  regarding  the  structure  and  content 
of  a  particular  data  base  is  obtainable  via  the 
NAMES  and  FUNCTION  commands.  The  NAMES 
command  allows  the  user  to  determine  attribute 
names  (acronyms)  and  corresponding  data  types. 
A  brief  description  is  provided  for  each  attribute 
name  printed.  After  the  selected  attribute  names 
have  been  printed,  the  user  may  examine  the  set 
of  possible  values  assumed  by  character-and 
multiple-choice-type  attributes.  For  numeric-type 
attributes,  the  user  may  obtain  arithmetic  means 
and  ranges  by  selecting  the  MEAN  function  after 
issuing  the  FUNCTION  command. 

A  partition  of  a  data  base  is  created  when  a 
retrieval  has  been  made  using  the  CONDITIONS, 
LOGIC,  and  SEARCH  commands.  The  displaying  of 
selective  attribute  values  for  records  of  this  partition 
is  accomplished  by  using  the  LIST  or  DUMP  com- 
mands. The  DUMP  command  permits  the  user  to 
print  all  values  present  for  attributes  in  a  selected 
set  of  categories.  The  values  are  printed  one  to  a 
line  with  the  corresponding  attribute  name.  The 
LIST  command  permits  the  selection  of  specific 
attributes  or  arithmetic  expressions  containing 
attribute  names  for  printing.  The  printing  is  select- 
ably  formatted  into  columns  or  rows.  For  columnar 


output,  the  user  may  create  a  separate  data  set 
which  could  be  used  by  other  programs  at  a  later 
time. 

DATA-BASE  IMPLEMENTATION 

In  the  previous  section  on  file  description,  it  was 
noted  that  the  various  files  were  integral  to  and 
necessary  for  GRASP  to  function.  There  are  ap- 
proximately as  many  methods  of  data  collection  as 
there  are  data  bases,  and  it  is  not  the  intention  of 
the  writers  to  dictate  data-base  structures  or  meth- 
ods of  data  collection.  However,  the  following  sug- 
gestions will  facilitate  the  construction  of  the  files 
necessary  for  GRASP  implementation. 

The  structure  of  any  GRASP  data  base  must  be 
such  that  it  can  be  manifest  in  a  tabular  fashion. 
The  table  representing  a  data  base  is  composed  of 
columns  that  are  attributes  and  rows  that  are  items 
described  by  these  attributes.  For  purposes  of  this 
report,  the  word  "record"  will  be  used  in  reference 
to  rows.  Before  any  files  can  be  constructed,  a  com- 
prehensive list  of  names  of  attributes  (or  column 
headings)  must  be  compiled.  Keep  in  mind  that  this 
arrangement  of  attributes  will  describe  every  rec- 
ord in  the  data  base,  and  that  although  provision 
is  made  for  all  attributes,  no  record  need  contain 
data  on  every  attribute.  For  each  attribute  that 
assumes  a  character-string  value,  a  dictionary  is 
compiled  whose  entries  are  the  values  assumed  by 
that  attribute.  These  dictionaries  are  used  to  create 
the  Dictionary  file.  Once  the  Dictionary  file  is  con- 
structed, the  record  number  (that  is,  pointer)  of 
the  first  entry  (that  is,  value)  for  each  character- 
type  attribute  is  known.  By  using  this  information 
and  the  previously  compiled  list  of  names  of  attri- 
butes, the  Mask  file  can  be  created.  Next,  all  attri- 
butes should  be  grouped  into  categories  of  related 
information.  This  grouping  provides  the  informa- 
tion necessary  for  the  construction  of  the  Defini- 
tions file.  For  multiple-choice-type  attributes  one 
simply  needs  to  assign  and  to  delineate  value  ac- 
ronyms for  each  attribute  in  a  record.  Each  group 
of  value  acronyms  forms  a  set,  and  the  collection  of 
sets  forms  the  Multiple-choice  file. 

Finally,  the  Numeric  Master  file  is  constructed, 
one  record  at  a  time.  The  individual  record  is  con- 
structed by  assigning  values  for  each  attribute  in 
the  order  of  its  occurrence  in  the  Mask  file.  For 
integer  or  real  attributes,  the  value  is  inserted  direct- 
ly. For  character-type  attributes,  the  entry  number 
of  the  value  in  the  appropriate  dictionary  is  inserted. 
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For  multiple-choice-type  attributes,  the  binary  en- 
coded word  that  describes  its  value  is  inserted.  The 
record  is  then  compressed  as  described  in  the  sec- 
tion "Data  File  Structures." 

USE  OF  GRASP 

From  the  viewpoint  of  a  user,  GRASP  is  a  mech- 
anism for  obtaining  information  from  a  data  bank 
in  a  very  simplistic  and  rigid  manner.  The  "lang- 
uage" which  is  used  to  "direct"  GRASP  is  composed 
of  11  "commands."  These  commands  can  logically 
be  divided  into  four  groups. 

GROUP  1  (FILES,  NAMES)  is  used  to: 

A.  Select  or  change  the  data  base  of  interest. 

B.  Obtain  information  regarding  the  nomenclature 

and  content  of  the  selected  data  base. 
GROUP  2  (LIST,  DUMP,  FUNCTION)  is  used 
to: 

A.  Examine  a  selected  set  of  records  that  is  called 

a  file. 

B.  Perform  selected  computations  of  numeric  attri- 

butes in  a  file. 

GROUP  3  (CONDITIONS,  LOGIC,  SEARCH) 
is  used  to  perform  a  retrieval  (SEARCH)  on  the 
data  bank  based  on  given  criteria  (CONDI- 
TIONS) which  are  combined  via  a  logical  ex- 
pression (LOGIC),  a  shorthand  method  of  indi- 
cating which  records  of  the  data  bank  are  to  be 
retrieved. 

GROUP  4  (HELP,  REVIEW,  QUIT)  is  used  to: 

A.  Obtain  brief  information  about  the  commands 

that  GRASP  will  accept. 

B.  Obtain   information   regarding  the  history  and 

status  of  the  current  session  with  GRASP. 

C.  Terminate  the  current  session  with  GRASP. 
All  commands  except  HELP  and  REVIEW  will 

ask  for  some  type  of  response.  Each  response  enter- 
ed must  end  by  striking  the  "cr"  (RETURN)  key. 
If  a  typing  error  or  incorrect  response  is  given,  the 
system  asks  for  another  response.  If  at  any  point 
the  system  seems  to  be  idle  it  is  a  good  practice  to 
strike  the  cr  key.  Certain  commands  (SEARCH, 
LIST,  DUMP,  FUNCTION)  require  an  input  file 
name.  Entering  a  blank  name  in  response  to 
prompts  generated  by  these  commands  (that  is,  cr 
only)  results  in  the  selection  of  the  current  Numeric 
Master  file  (as  specified  in  the  most  recent  FILE 
command).  The  LIST  and  DUMP  commands  also 
ask  for  the  number  of  lines  per  page.  This  causes  the 
system  to  pause  after  each  printing  of  this  number 
of  lines,  awaiting  a  response  from  the  user.  The 
user  may  then  make  a  hard  copy  and   (or)   clear 


!  the  screen  if  using  a  CRT  terminal.  Also,  the  user 
may  terminate  the  printing  altogether.  At  each 
pause,  the  user  should  enter  a  nonblank  character 
followed  by  a  cr  if  it  is  desired  to  abort  the  rest  of 
the  printout;  otherwise,  only  a  cr  will  continue 
printing.  The  method  of  calling  the  GRASP  system 
into  execution  will  vary,  depending  on  what  compu- 
ter is  used.  At  the  beginning  of  execution,  the 
GRASP  system  will  print  out  the  names  and  descrip- 
tions of  the  data  bases  available.  The  data-base 
name  corresponds  to  the  name  of  the  Numeric 
Master  file.  Assume,  for  purposes  of  explanation, 
that  a  data  consisting  of  oil  and  gas  pools  in  the 
State  of  Colorado  is  available  and  named  COLFIL. 
Following  is  a  discussion  of  each  command: 

FILES. — This  command  is  used  to  select  a  data 
base  and  may  be  issued  at  any  time  during  a  session. 
The  individual-attribute  names  for  any  one  data 
base  will  not  be  recognized  by  GRASP  until  this 
command  has  been  issued.  The  user  must  enter  a 
data-base  name  when  the  system  asks  for  it. 

NAMES. — This  command  is  used  to  list  the  ac- 
ronyms which  will  be  used  to  identify  individual 
attributes  within  a  record  (that  is,  pool)  and  their 
meaning.  First,  17  categories  are  printed.  Then  the 
system  asks  the  user  to  enter  a  list  of  numbers  cor- 
responding to  the  categories  of  interest.  The  list 
should  be  composed  of  individual  numbers  or  num- 
ber ranges  (such  as  2-5),  each  of  which  must  be 
separated  by  a  comma.  The  list  must  be  terminated 
by  the  cr  key:  for  example,  1,  2-5,  9  cr  and  1—4, 
10,  11  cr.  The  system  then  lists  each  acronym 
and  its  meaning  for  all  the  categories  of  inter- 
est. After  each  category  is  complete,  the  sys- 
tem pauses.  At  this  point  the  user  must  enter 
cr  to  continue,  or  enter  any  letter  (or  digit) 
followed  by  cr  to  stop.  After  all  categories  have 
been  completed,  the  system  asks  if  the  user  would 
like  to  see  the  possible  values  of  any  character-type 
or  multiple-choice-type  items.  The  user  must  then 
enter  Y  or  N  followed  by  cr  to  indicate  his  decision. 
If  the  user  enters  N,  the  system  will  ask  the  user 
to  enter  his  next  command.  If  the  user  enters  Y,  the 
system  asks  for  the  names  (acronyms)  of  the  attri- 
butes of  interest.  The  names  are  prompted  and  are 
given  one  per  line  followed  by  a  cr.  After  each  name 
is  given,  the  system  skips  to  the  next  line  and  prints 
a  numeral.  To  end  the  list  (a  maximum  of  10  names 
may  appear),  enter  cr  (with  no  name).  The  system 
then  starts  printing  the  attribute  names  and  possi- 
ble values,  pausing  after  each  name  is  complete.  A 
pause  also  occurs  after  30  lines  of  print.  At  each 
pause,  enter  cr  to  continue  or  any  letter  (or  digit) 


USE  OF  GRASP 


11 


followed  by  cr  to  stop.  After  this  process  is  com- 
pleted, the  system  then  asks  if  the  user  would  like 
to  see  any  more  possible  values.  Again,  enter  Y  for 
yes  or  N  for  no. 

LIST. — This  command  is  used  to  output  selected 
attribute  values  (or  expressions)  from  a  selected 
file.  Output  may  be  to  an  interactive  terminal  or  to 
a  specified  data  set  which  could  be  processed  at  some 
later  time  by  other  programs.  The  system  first  asks 
the  user  for  the  input-file  name  and  the  number  of 
lines  per  page.  The  user  is  next  asked  to  enter  C  for 
column  printing  or  R  for  row  printing.  If  column 
output  is  selected,  the  user  is  asked  if  he  wants  out- 
put to  be  to  a  disk  data  set  in  character  form.  If  so, 
the  system  will  ask  for  a  data-set  name.  Column 
output  prints  the  selected  acronyms  as  headings  and 
their  respective  values  below.  Each  column  is  com- 
posed of  8  character  positions  in  a  field  of  10.  One 
line  of  column  output  corresponds  to  one  record. 
Row  output  consists  of  lines,  each  of  which  contain 
an  acronym  and  its  corresponding  value.  If  the 
value  for  a  selected  attribute  is  missing,  the  attri- 
bute name  is  not  printed.  Records  are  separated  by 
a  line  of  asterisks.  Before  output  proceeds,  the  sys- 
tem asks  for  the  names  of  attributes  or  expressions 
which  are  desired.  This  is  done  by  prompting  with 
index  numbers. 

Expressions  may  optionally  be  preceded  by  some 
name.  Five  intrinsic  functions  are  available:  square 
root  (SQRT),  square  (SQR),  log  base  10  (LOG), 
power  of  ten  (TEN),  and  absolute  value  (ABS). 
Expressions  may  involve  these  intrinsic  functions, 
attribute  names,  numeric  constants,  the  arithmetic 
operators  (  +  ,  -,  *,  /),  and  the  grouping  symbols 
(  ).  The  following  is  an  example  of  a  list  to  be 
output : 

1.  POOL 

2.  FIELD 

3.  DEPTH 

4.  LOG  (DEPTH) 

5.  WELLAV  =  CRUAN69/(NUMPOOL- 
TOTPROD) 

6. 

In  the  above  example,  GRASP  has  prompted  with 
the  index  numbers  1-6.  Note  that  the  list  is  termi- 
nated by  a  blank  entry. 

DUMP. — This  command  is  very  similar  to  the 
LIST  command  having  row  printing  specified.  In- 
stead of  asking  for  a  list  of  names,  the  system  asks 
for  a  list  of  category  numbers.  It  then  prints  (in 
row  fashion)  the  attribute  name  and  value  for  each 


attribute  present  in  the  selected  categories  of  the 
specified  file. 

FUNCTION. — This  command  performs  functions 
on  a  file.  Currently,  the  only  functions  available  are 
the  arithmetic  mean  (MEAN)  and  a  linear  least- 
square  fit  (FIT)  of  two  attributes.  The  system  asks 
for  the  name  of  the  input  file.  Next,  the  user  is  asked 
for  the  name  of  the  function  and  names  of  the  argu- 
ments. The  argument  names  are  the  acronyms  for 
attributes  within  a  record;  as  many  as  five  may  be 
given.  For  instance,  if  MEAN  DEPTH,  TOTPROD, 
CRUCM70  cr  were  entered,  the  range,  mean,  root 
mean  square,  sum,  and  sum  of  squares  for  DEPTH, 
TOTPROD,  and  CRUCM70  would  be  computed  and 
printed.  If  FIT  DEPTH,  TOTPROD  cr  were  en- 
tered, the  system  would  respond  with  the  slope, 
intercept,  and  correlation  coefficient.  Values  for  all 
attributes  in  a  record  must  be  present  for  that  rec- 
ord to  be  included  in  a  computation. 

CONDITIONS.— This  command  is  used  to  enter 
a  set  of  retrieval  criteria.  Each  criterion  must  be 
given  in  the  form  acronym  relation  value,  where 
acronym,  is  an  attribute  name  (such  as  COUNTY, 
CRUCM69,  POOL) ,  where  relation  is  EQ,  NE,  GT, 
LT,  LE,  GE,  or  BE,  and  where  value  is  a  number 
or  a  series  of  letters  (such  as  ADAMS,  19342,  MIS- 
SISSIPPIAN).  The  above  relations  have  the  follow- 
ing meanings : 

EQ — equal  to. 

NE — not  equal  to. 

GT — greater  than. 

LT — less  than. 

LE — less  than  or  equal  to. 

GE — greater  than  or  equal  to. 

BE — between  (numerically,  inclusive) . 
The  system  precedes  each  condition  with  a  letter 
prompt  (up  to  26  may  be  entered),  which  will  be 
used  in  the  logic  expression  that  combines  the  con- 
ditions. Entering  cr  by  itself  terminates  the  list  of 
conditions.  Following  is  an  example  of  a  set  of  con- 
ditions : 

A.  COUNTY  EQ  BACA 

B.  DEPTH  BE  5000,6000 

C.  TOTPROD  GE  10 

D.  LITHOL  NE  DOLOMITE 

E.  COUNTY  EQ  ADAMS 

F.  POOL  NE  MISSISSIPIAN 
G. 

In  the  above  example,  the  system  provided  the  let- 
ters A  through  G  as  prompts. 

LOGIC. — This  command  is  used  to  enter  a  logical 
or  connective  expression  which  combines  the  pre- 


12 


GEOLOGIC  RETRIEVAL  AND  SYNOPSIS  PROGRAM    (GRASP) 


viously  entered  conditions  to  form  the  retrieval  cri- 
terion. The  logical  expression  may  be  composed  of 
the  logical  connectives  (operators),  the  letters  cor- 
responding to  the  criteria  entered  via  the  CONDI- 
TIONS command,  and  the  grouping  symbols  (  ). 
The  logical  connectives  are  AND,  inclusive  OR,  and 
NOT  (written  .AND.,  .OR.,  .NOT.).  Note  that  they 
are  each  bracketed  by  periods.  Provision  has  also 
been  made  to  use  *  (for  AND),  +  (for  OR),  —  (for 
NOT).  Assume  that  the  example  conditions  given 
in  the  preceding  CONDITIONS  command  section 
had  been  entered.  If  the  user  wanted  to  retrieve  the 
pools  in  Baca  County  that  had  a  depth  of  5,000-6,000 
feet,  the  logic  expression  would  be  A  .AND.  B  cr. 
If  all  the  pools  in  Adams  and  Baca  Counties  except 
those  of  Mississippian  age  having  dolomite  lithology 
were  desired,  the  logic  expression  would  be  (A  .OR. 
E)  .AND.  (D  .AND.  F)  cr.  Note  that  the  last  pair 
of  parentheses  is  not  really  needed.  The  ANDs  will 
be  applied  before  the  ORs.  NOTs  are  applied  before 
ANDs  and  ORs.  Hence,  the  first  set  (A.  OR.  E)  is 
necessary  so  that  the  E  is  connected  to  A  instead 
of  to  D.  If  one  wanted  to  retrieve  all  pools  with  at 
least  10  producing  wells  having  a  depth  greater  than 
6,000  feet  or  less  than  5,000  feet,  the  logic  expression 
would  be  .NOT.  B  .AND.  C  cr.  If  one  wanted  to 
retrieve  all  pools  having  less  than  10  producing 
wells  in  the  same  range  as  above,  one  could  use 
.NOT.  (B  .OR.  C)  cr  for  a  logic  expression.  This 
expression,  in  words,  says  "if  the  pool  has  a  depth 
of  5,000-6,000  feet,  or  if  it  has  10  or  more  pro- 
ducing wells,  I  don't  want  it." 

SEARCH. — After  the  system  has  been  given  the 
conditions  and  connecting  logic  that  compose  the 
question  to  be  asked  of  some  file,  an  actual  search 
of  the  data  bank  can  be  made.  This  is  done  with  the 
SEARCH  command.  The  system  will  ask  for  the 
name  of  the  file  to  be  searched  (input  file)  and  the 
name  to  call  the  file  of  records  found  (output  file). 
After  the  search  has  been  made,  the  system  types 


the  number  of  records  searched  and  the  number  of 
records  found.  The  capability  of  entering  both  input 
and  output  file  names  allows  the  user  to  perform 
"nested"  searches.  This  means  searches  of  files  that 
were  the  result  of  previous  searches.  Frequently 
this  is  the  most  economical  way  of  performing 
multiple  or  complex  retrievals.  For  instance,  sup- 
pose one  wanted  information  on  several  sets  of 
pools,  all  of  which  were  in  one  county.  One  would 
first  create  an  output  file  that  contained  all  the 
pools  in  that  county  and  then  use  that  file  as  the 
input  file  for  subsequent  searches. 

HELP. — This  command  is  used  to  print  a  list  of 
the  possible  commands  and  a  brief  description  of 
their  functions. 

REVIEW. — This  command  provides  a  review  of 
the  conditions  and  logic  which  are  currently  in 
effect.  The  names  of  input  and  output  files  for  the 
last  10  retrievals  are  also  printed.  This  command 
is  used  to  refresh  one's  memory  on  what  was  done 
recently  during  the  current  session. 

QUIT. — This  command  is  used  to  exit  from  the 
GRASP  system.  A  list  of  the  files  created  during 
this  session  is  printed,  and  the  user  is  permitted  to 
save  them  for  future  use.  Abnormal  session  inter- 
rupts and  terminations  will  cause  GRASP  to  cease 
functioning.  However,  all  files  created  during  the 
active  session  are  either  saved  or  not  saved,  accord- 
ing to  the  abnormal  termination  rules  of  the  partic- 
ular computing  system.  On  abnormal  termination, 
GRASP  neither  saves  nor  deletes  files. 
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GRASP  SOFTWARE  SPECIFICATIONS 

MODULE  NAME:  DRIVER 

Purpose:  DRIVER  is  used  primarily  as  a  switching/ calling 
mechanism.  User  commands  are  accepted  and  decoded.  Con- 
trol is  then  passed  to  the  routine  designed  to  process  the 
given  command.  This  process  continues  until  the  user  "quits." 

Subroutines  called:  START,  KEYBRD,  CONDTN,  LOGEXP, 
RETRVE,  FTNC,  FILES,  CONDS,  HELP,  DUMPIT, 
NAME,  LIST,  QUIT,  PACK. 

Common  data  referenced:  None 

Called  by:  None 

Error  checking  and  reporting:  The  command  entered  by  the 
user  is  checked  against  the  list  of  legal  commands.  If  a 
command  is  not  recognized,   it  is  echoed  back  to  the   user 


terminal  with  a  message  suggesting  use  of  the  HELP  com- 
mand. 
Program  logic: 

1.  Initialization  is  performed  by  zeroing  counters  and  call- 
ing START. 

2.  An  unpacked  character  string  is  accepted  from  the  user 
via  subroutine  KEYBRD. 

3.  A  four-character  command  is  formed  by  packing  the  above 
string  into  COMMAND. 

4.  COMMAND  is  then  compared  with  the  list  (WORDS)  of 
acceptable  command  words  (NAMES).  When  a  match  is 
found,  control  is  transferred  to  the  appropriate  subroutine 
via  a  computed  GO  TO. 

5.  Steps  2  through  4  are  repeated  until  an  end-of-file  (EOF) 
condition  is  sensed  on  the  terminal  or  until  the  QLTIT  com- 
mand is  executed. 
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SOURCE 


PROGRAM 


113 


120 


130 
140 

150 

160 


170 


190 


180 


2  0C 


21C 


220 


INTEGER    WORD S( 11)  ,C CMANO ,NAMEPT ( 2 6)  ,RCPDE(26 ), I VAL(26) , POL  IS H ( 30 ) 000000 1 

1     ,IMAGE(5), IFILES(20),OFILES(20)  0000002 
DATA    WORD  SECOND'  ,  •  LOG  I  •  ,  •  SE  AR«  ,  •  L  1ST  •  ,  •  F  HE*  ,  •  QU  IT  • ,  ■  NAME  •  ,  '  HELP  •  0000003 

It  'REVI  •  ,  •DUMP",  •FUNC1/,  IBLNK/'     •/  000030<* 

NFILES=0  0000005 

LPS=0  0000006 

CALL     START  0000007 

TYPE    270  0C00008 

COMAND=IBLNK  0000009 

CALL    KEYBRDU260,  IMAGE,  4)  0003310 

CALL     PACK( IMAGE ,C0MAND,4,4)  0000011 

DO     120    1=1,11  O0CO012 

IF     (C0MAND.EQ.W0RDS( I ) )     GO    TO     130  0000013 

CONTINUE  0000014 

TYPE     290,    COMAND  0000015 

GO    TO    110  00C0016 

GO    TO     (140,150,160,240,190,260,230,210,180,220,170),     I  0000017 

CALL     C0NDTNi(&ll0,NAMEPT,RC0DE  ,1  VAL  ,NREXP)  0000018 

GO    TO    110  0000019 

CALL    LOGEXP U110, POLISH, LPS, NREXP)  OOC0020 

GO    TO    110  0000021 

CALL     RETRVE (& 150, &110, I F I LES , OF ILE S, NF IL ES , POL ISH, LPS , NAMEPT ,  00000  22 

1    RCODE, IVAL , NREXP)  0000023 

GO    TO    110  00C0024 

CALL    FTNCUUO)  0000025 

GO    TO     110  0000026 

CALL    FILESU110)  0000027 

GO    TO     110  0000028 

CALL     CONDS(NREXP,LPS)  0000029 

IF    (NFILES.GT.O )    GO    TO    200  0000030 

TYPE     300  0000031 

GO    TO     110  0000032 

TYPE    310,     <  IFILESi  I)  ,OFILES ( I  ), l=l,NFILES)  00C0033 

GO    TO     110  0000034 

CALL     HELP(WORDS)  0000035 

GO    TO     110  0000036 

CALL     DUMPIT  0000037 

GO    TO    110  0000038 
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23C    CALL    NAME(£110I  0C00039 

GO    TO     110  0000040 

24C    CALL    LlST(filiO)  0000041 

GO    TO     110  0000042 

26C    CALL    QUIT(OFILES,NFILES)  0000043 

STOP  0000044 

270    FORMAT    (//•     ENTER    COMMAND:     »,$)  0000045 

290    FORMAT     (IX, A5,'     ILLEGAL    COMMAND.    ENTER    HELP  IF    YOU    WISH    TO    SEE1,       0000046 

1'     THE     LEGAL    COMMANDS.1/ )  0000047 

30C     FORMAT     (•    NO    FILES    HAVE    BEEN    USED    AT    THIS    TIME.')  0000048 

31C    FORMAT     (•     INPUT:          OUTPUT :•/( 2X, A5 t 2X, A5/ ) )  0000049 

END  0000050 
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SUBROUTINE  NAME:  ACCESS 

Purpose:  ACCESS  looks  up  character-string  values  in  dic- 
tionary files.  In  order  to  minimize  disk  accesses,  five  previous 
values  are  saved  for  as  many  as  100  distinct  character-type 
items. 

Calling  sequence:  CALL  ACCESS  (NUMD,IVAL,TANK, 
NWORDS,ISWTCH) 

Arguments : 

NUMD — Item  number  of  the  character-type  variable  whose 

values  are  to  be  accessed. 
IVAL — Direct-access  key  under  which  value  is  stored. 
TANK — Contains  the  character  value  accessed. 
NWORDS— The  number  of  words  in  TANK. 
ISWTCH — Switch  to  control   which  of  the  following  four 
functions  are  desired : 

1.  Initialization  for  dictionary  lookup. 

2.  Lookup  a  random  item. 

3.  Return   the   direct-access   key   of  the   first   item   in   this 

dictionary. 


4.  Return  the  indicated  (by  IVAL)  entry  and  the  KEY  for 
the  next  entry  (that  is,  reset  IVAL). 

Subroutines  called:  None 

Common  data  referenced:  IDPT  in  /DACOMM/ 

Called  by:  BDEF,  COLPNT,  DUMPIT,  PNTER,  ROWPNT 

Error  checking  and  reporting :  None 

Program  Logic:  The  logic  is  divided  into  four  sections  relat- 
ing to  values  of  ISWTCH. 

1.  If  ISWTCH  =  1,  initialize  saved  pointer  arrays  (USED, 
LASTDX)  and  set  character  variable  counter  NCVAR  to 
zero. 

2.  If  ISWTCH  =  2,  see  if  the  value  has  been  stored  in  BUF- 
FER. If  so,  return  it;  otherwise  access  it  on  FORTRAN 
unit  21  and  save  its  value  (TANK),  index  (IVAL)  and 
the  item  number  (NUMD). 

3.  If  ISWTCH  =  3,  return  the  direct-access  key  for  the  first 
entry  of  the  dictionary  pointed  to  by  NUMD. 

4.  If  ISWTCH  =  4,  access  the  entry  pointed  to  by  IVAL  and 
reset  IVAL  to  the  key  for  the  next  entry  in  this  dictionary. 


GRASP 


SOURCE 


PROGRAM 


100 


150 


t21/ 

, ISWTCH 


10 


15 


20 
30 


40 


50 


60 


70 


SUBROUTINE    ACCESS (NUMD, IVAL , TANK ,N WORD S, I SWTCH ) 
COMMON    /DACOMM/    NV,IDPT 

INTEGER  TANK( 1) , BUFFER ( 5 , 100,5 ) , USED (10  0) , INDEX (100) 

1    LASTDX(5, 100), IDPT( 500) 
DATA     IBLNK,NDICT/'     • 
GO    TO    (5,15,100,150) 
NCVAR=0 
DO    10    J=l,100 
USED( J)=0 
DO    10     1=1,5 
LASTDXi  I  ,  J)=-999999 
GO    TO     320 

IF(NCVAR.EQ.O)     GO    TO    30 
DO    20    KK=1,  NCVAR 
IF(  IN|DEX(KK  ).EQ.NUMD  )    GO    TO    40 
CONTINUE 
NCVAR=NCVAR+i 
IF(NCVAR.GT .100 )    NCVAR=100 
KK=NCVAR 
INDEX( KK)=NUMD 
IF(USED(KK)  .EQ.0)    GO    TO    240 
DO    50    K=l,5 

IF(  IVAL  .EQ.LASTDX( K,KK )  )    GO    TO    60 
CONTINUE 
GO    TO    240 
NW0RDS=5 
DO    70     1=1, NWORDS 
TANKt I )=BUFFER( I ,KK,K) 
GO    TO    320 

I  VAL=IDPT (NUMD) 
GO    TO    320 

READ(N0ICT«  IVAL)    NP, NWORDS,  (TANK (  I  ),  1  =  1, NWORDS) 
I VAL=NP 
GO    TO     320 


0000351 

0000052 

0000053 

0000354 

0000055 

0000056 

0000057 

0000058 

0000059 

0000060 

0000061 

0000062 

0000063 

0000064 

0000065 

0000066 

0000067 

0000068 

0000069 

0000070 

0000071 

0000072 

0000073 

0000074 

0000075 

0000076 

0000077 

0000078 

0000079 

0000080 

0000081 

00C0082 

0000083 

0000084 
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2^0  ISTART=IDPT(NUMD)  0000085 

RE  AD  INDICT*  I  START* I VAL- 1  )    NP , NWORDS , < TANK ( I ), I=l,NWORDS)  0000086 

USED(KK)=M0D(USED(KK>,5)+1  0000087 

NUSFD=USED( KK )  C0C0088 

DO    26C    1=1,5  0000089 

260    BUFFER! I, KK ,NUSED ) = IBLNK  0000090 

NWORD=MIN0< NWORDS,5 )  0000091 

DO    27C    I=l,NWORD  0000092 

270    BUFFER(  I , KK ,NUSED )  =  TANK( I  )  0000093 

LASTDX(NUSED,KK )=IVAL  000009^ 

320    RETURN  0000095 

END  0000096 
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SUBROUTINE  NAME:  BDEF 

Purpose:  BDEF  provides  access  to  the  character  and  multiple- 
choice  dictionaries. 

Calling  sequence:  CALL  BDEF(&n) 

Argument : 

n — Statement  number  (in  caller)  to  which  a  branch  is  made 
if  an  EOF  is  sensed  by  KEYBRD. 

Subroutines  called:  KEYBRD,  VLIST,  ACCESS,  PAUSE, 
BINTYP,  IFILE 

Common  data  referenced: 

FNAMES,  WHICH  in  /FILNAM/ 
ITYPE  in  blank  common 

Called  by:  NAME 

Error  checking  and  reporting:  The  user  response  to  a  "yes/ 
no"  question  is  checked.  If  illegal,  a  message  is  typed,  and 
the  user  is  prompted  for  another  response.  If  an  item  is 
selected  that  is  not  a  multiple-choice  or  character-type  item, 
a  message  is  typed,  and  the  user  is  requested  to  reenter  a 
list  of  item  names. 


Program  logic:  The  user  is  prompted  to  determine  if  a  list  of 
multiple-choice  or  character-type  values  is  desired.  If  the 
response  (obtained  from  KEYBRD)  is  "N",  a  branch  is 
made  to  the  end  of  the  routine.  If  the  response  is  "Y,"  a  list 
of  item  names  is  obtained  by  a  call  to  VLIST.  If  an  EOF 
is  sensed,  the  nonstandard  return  (from  VLIST)  exits  via 
the  nonstandard  return  of  BDEF.  The  data  type  is  deter- 
mined for  each  name  (TAGS)  returned  by  VLIST.  If  the 
type  is  not  multiple  choice  or  character,  that  message  is 
typed,  and  the  next  element  of  TAGS  is  considered.  If  the 
type  is  multiple  choice,  a  call  to  BINTYP  is  used  to  ob- 
tain the  permissible  values  for  printing.  If  the  type  is  char- 
acter, calls  to  ACCESS  are  made  to  obtain  the  possible 
values.  When  the  second  argument  of  ACCESS  is  returned 
as  zero,  all  possible  values  have  been  referenced.  A  pro- 
grammed pause  is  generated  after  each  30  lines  of  print 
and  after  each  item  in  TAGS  is  processed.  Just  prior  to  re- 
turn (standard  or  nonstandard),  unit  22  (the  binary  or 
multiple-choice  file)  is  l-ewound,  and  the  unit  number  is 
reassociated  with  the  current  file  name  via  a  call  to  IFILE. 


GRASP 


SOURCE 


PROGRAM 


10 
20 


30 


40 


50 
60 

70 


80 


SUBROUTINE  BDEF(*)  0000097 

COMMON  NAMES,  ITYPE,  IPTS,  IPAD  0000098 

COMMON  /FILNAM/  FN AM ES , WH ICH, PAD  0000099 

DOUBLE  PRECISION  LABEL ( 25 ), NAMES (500 ), TAGS (20 )  0000100 

INTEGER  IPTS(500) ,FNAMES( 21), WHICH, PAD(4)  0000101 
INTEGER  BINL(20) ,Y ES ,N0, REPLY , BIT  EM ( 15 ,25  ) , IT YPE ( 500 ) , TANK ( 25 >     0000102 

EQUIVALENCE  ( BI TEM(  1 , 1 )  ,TANK ( 1 ) )  0000103 

DATA  YES,NO,NBIN/'Y • , «N' ,22/  0000104 

TYPE  120  0000105 

TYPE  130  0000106 

CALL  KEYBRD(&110, REPLY,  1  )  0000107 

IF  (REPLY. EO. NO)  GO  TO  100  0000108 

IF  (REPLY. EQ. YES)  GO  TO  30  0000109 

TYPE  150  0000110 

GO  TO  20  0000111 

CALL  VLISTt £110, TAGS, B  INL,NUM)  0000112 

DO  90  N=l ,NUM  0C00113 

INDEX=BINL(N)  0000114 

IF  (  ITYPEUNDEX  )-3)  60,40,70  0000115 

TYPE  190,  TAGS(N)  0000116 

CALL  ACCESS ( INDEX, K, TANK, NOM,  3)  0000117 

DO  50  J=l, 10000  0000118 

CALL  ACCESSUNDEX,  K,TANK,M,4)  0000119 

TYPF  160,  ( TANK( I ) ,I=1,M)  0000120 

IF(K.EO.O)  GO  TO  90  0000121 

IF  (M0D( J, 30) .NE.0)  GO  TO  50  0000122 

CALL  PAUSE(CIOO)  C000123 

CONTINUE  0000124 

TYPE  170,  TAGS(N)  0000125 

GO  TO  90  0000126 

IF( I TYPE( INDEX) .NE.4)  GO  TO  60  0000127 

CALL  B INTYP ( INDEX, LABEL, BITEM,K,M)  0000128 

TYPE  190,  TAGS(N)  0000129 

DO  80  J=1,M  0000130 

TYPE  180,  LABEL! J) ,(BITEM( I ,J)  ,1 =1,K)  0000131 
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90    CALL     PAUSE(QIOO)  0000132 

GO    TO    10  0000133 

100               REWIND    NB IN  0000134 

CALL     IFILE(NBIN, FNAMES (16+WHICH))  00C0135 

RETURN  0000136 

110               REWIND    NB IN  0000137 

CALL     IFILE(NBIN,FNAMES(16+WHICH) )  0000138 

RETURN    1  0000139 

120    FORMAT     (•    WOULD    YOU    LIKE    TO    SEE    THE     POSSIBLE    VALUES  •,,0F    MULTI PLE0000140 

1    CHOICE' /•     OR    CHARACTER    TYPE     ITEMS?')  0000141 

130    FORMAT    (•        (ENTER    Y    FOR    YES    ,     N    FOR    NO):     '♦$)  0000142 

150    FORMAT    (•    YOUR    REPLY    WAS    NOT    UNDERSTOOD.')  0000143 

160    FORMAT    (10X,12A5)  0000144 

17C    FORMAT    (1X,A8,'IS    NOT    A    MULTIPLE    CHOICE    OR    CHARACTER    TYPE     ITEM.')    0000145 

180    FORMAT     ( I IX , A7 , •- • , 1 5A4  )  0000146 

190    FORMAT    (LXfA8«a=*)  0000147 

END  0000148 
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SUBROUTINE  NAME:  BFIND 

Purpose:  BFIND  is  used  to  look  up  a  double-word-item  name 

in  a  list  of  double-word-item  names  having  a  given  sorted 

order. 
Calling     sequence:     CALL     BFIND  (&n,KEY,IPOST,KEYS, 

INDEX.K) 
Arguments: 

n — Statement  number  (in  caller)  to  which  a  branch  is  made 
if  the  name  KEY  is  not  in  the  list  of  names  KEYS. 

KEY — The  double-word  item  to  be  looked  up. 

IPOST— The  position  in  KEYS  of  the  item  KEY. 


KEYS — The  list  of  double-word  names  that  will  be  used  to 

look  up  KEY. 
INDEX— Gives  the  indices  of  the  sorted  form  of  KEYS. 
K — The  number  of  elements  in  KEYS. 

Subroutines  called:  None 

Common  data  referenced:  None 

Called  by:  DECOMP,  PARSE,  RELEXP,  VLIST 

Error  checking  and  reporting :  None 

Program  logic:  The  standard  binary-search  technique  is  used, 
which  repeatedly  halves  the  interval  of  search  on  a  sorted 
list.  If  the  interval  of  search  goes  negative,  the  element  is 
not  in  the  list  and  the  nonstandard  return  is  taken. 


GRASP 


SOURCE 


PROGRAM 


SUBROUTINE    BFIND(* ,KEY,  IPOST, KEYS,  INDEX, K) 

DOUBLE    PRECISION    KEY,KEYS(1) 

DIMENSION    INDEX(l) 

Ll=l 

L2=K 
70     IF    (L2.1T.L1)     RETURN    I 

J=(L1+L2) /2 

I=INDEX( J ) 

IF     (OABS(KEY).GT.DABS<KEYS(  I  )  ) )    GO    TO    9C 

IF     (DABS(KEY) . LT.OABS ( KEYS( I ) ) )    GO    TO    80 

GO    TO     100 
80    L2=J-1 

GO    TO     70 
90    L1=J  +  1 

GO    TO    70 
100    IP0ST=I 

RETURN 

END 


0000149 
0000150 
00C0151 
0000152 
0000153 
0000154 
0000155 
0000156 
0000157 
0000158 
0000159 
0000160 
0000161 
0000162 
0000163 
0000164 
0000165 
0000166 
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SUBROUTINE  NAME:  BINIT 

Purpose:  BINIT  is  used  to  sort  a  list  of  double-precision  words 
(NAMES,  in  this  instance)  into  ascending  order  and  re- 
turn an  array  of  indices  giving  the  sorted  order  of  the 
elements  in  terms  of  the  unsorted  order. 

Calling  sequence:  CALL  BINIT (KEYS,INDEX,M) 

Arguments : 

KEYS — The  list  of  double-precision  words  to  be  sorted. 
INDEX — An  array  of  indicies   giving  the   unsorted   order 


of  KEYS. 
M— The  number  of  words  in  the  KEYS  and  INDEX  arrays. 

Subroutines  called:  None 

Common  data  referenced:  None 

Called  by:  FILES 

Error  checking  and  reporting :  None 

Program  logic:  An  in-place  sort  is  performed  using  the  stand- 
ard "Shell"  technique.  The  original  order  of  KEYS  is  over- 
written, and  the  sorted  order  is  returned  in  INDEX. 


GRASP 


SOURCE 


PROGRAM 


SUBROUTINE    BIN  I T ( K EYS,  I NDEX ,M ) 

DOUBLE  PRECISION  KEYS( 1 ) , KTEMP 

INTEGER  INDEX(l) 

DO  10  J  =  1,M 
10  INDEX(JI=J 

M0=M 
20  IF  (MO.LE.l )  GO  TO  60 

J  =  4 

IF  (M0.GT.15I  J=8 

M0=2*<M0/J)+1 

K0=M-M0 

J0  =  1 
30  I=J0 
40  J=I+M0 

IF  (DABS(KEYS(  I  I)  .L E  .DABS ( K EY S ( J ))  )  GO 

KTEMP=KEYS( I ) 

KEYSl  I  )  =  KEYS( J) 

KEYS( J)=KTEMP 

ITEMP=INDEX(I ) 

INDEX(  I  )=  INDEXC  J) 

INDEX(J»=ITEMP 

I=I-M0 

IF  (  1-1  )  50,40,  40 
50  J0=J0+1 

IF  (JO-KO)  30,30,20 
60  RETURN 

END 


TO  50 


0000167 
0000168 
0000169 
0000170 
O0CO171 
0000172 
0000173 
0000174 
0000175 
0000176 
0000177 
0000178 
0000179 
0000180 
0000181 
0000182 
0000183 
0000184 
0000185 
0000186 
0000187 
0000188 
0000189 
G000190 
0000191 
0000192 
0000193 
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SUBROUTINE  NAME:  BINTYP 

Purpose:    BINTYP    reads    the    values     (LABEL,    BITEM) 

which    can    be    assumed    by    the    multiple-choice-type    item 

whose  number  is  NUMD. 
Calling  sequence:   CALL   BINTYP, (NUMD,LABEL,BITEM, 

LNG.NUM) 
Arguments : 

NUMD — Integer  specifying  a  multiple-choice-type  item. 

LABEL — Set  of  values  (double  word)  that  may  be  assumed 
by  this  item. 

BITEM — Set  of  descriptions  corresponding  to  elements  of 
LABEL. 


LNG — Maximum  length  of  a  description. 
NUM — The  number  of  descriptions. 

Subroutines  called:  IFILE 

Common  data  referenced:  FNAMES,  WHICH  in  /FILNAM/ 

Called  by:  BDEF,  COLPNT,  DUMPIT,  PNTER,  ROWPNT 

Error  checking  and  reporting :  None 

Program  logic:  Records  of  the  multiple-choice  (binary)  file 
are  read  sequentially  until  the  correct  record  is  obtained. 
If  the  file  was  positioned  past  the  desired  record  at  call 
time,  an  EOF  is  sensed,  the  file  is  rewound,  and  the  cur- 
rent multiple-choice  file  name  is  reassociated  with  unit  22. 


GRASP 


SOURCE 


PROGRAM 


SUBROUTINE    BINT YP ( NUMD , LABEL , BI TEM ,1 NG , NUM ) 

COMMON    /FILNAM/    FNAM ES , WH ICH , PAD 

DOUBLE    PRECISION    LABEL(l) 

INTEGER    FNAMES (21) , WHICH, PA D( 4),BITEM( 15, 25) 

DATA    NBIN/22/ 
300    READ(NBIN,END=310)    NAME , NUM , LNG , 

A     (LAB  EL (J ) , (BIT  EM (  I , J)  ,  1  =  1, LNG ) , J = 1 , NUM ) 

IF(NUMD-NAME)     310,320,300 
310    REWIND    NBIN 

CALL     IFILE(NBIN,FNAMES U6+WHICH)) 

GO    TO     300 
320    RETURN 

END 


C000194 
00C0195 
0000196 
0000197 
0000198 
0000199 
0000200 
0000201 
00002  02 
0000203 
0000204 
0000205 
0000206 
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SUBROUTINE  NAME:  BLIST 

Purpose:  BLIST  returns  a  list  of  numbers  giving  the  bit  posi- 
tions of  the  "ones"  in  a  binary  word. 

Calling  sequence:  CALL  BLIST (LIST,NUML,ICODE) 

Arguments : 

LIST — Array  of  integers  giving  the  bit  positions  in  ICODE 

which  are  "ones,"  counting  right  to  left. 
NUML— The  number  of  items  in  LIST. 
ICODE— The  binary  word  to  be  examined  by  BLIST. 


Subroutines  called:  None 

Common  data  referenced:  None 

Called  by:  COLPNT,  DUMPIT,  ROWPNT 

Error  checking  and  reporting:  None 

Program  logic:  ICODE  is  moved  to  IDUM.  IDUM  is  suc- 
cessively divided  by  2,  and  the  least  significant  bit  is  ac- 
cessed by  the  MOD  function.  If  the  least  significant  bit  is 
"one,"  the  position  counter  is  added  to  LIST. 


GRASP 


SOURCE 


PROGRAM 


10 
20 


SUBROUTINE    BL 1ST ( L 1ST , NUML, ICODE) 

INTEGER    LIST(l) 

NUML=0 

IDUM=ICODE 

DO    10    1=1,25 

IF    (IDUM.EQ.O)    GO    TO    20 

IF     (M0D(IDUM,2) .EQ.O)     GO    TO    10 

NUML=NUML+1 

LIST(NUML)=I 

IDUM=IDUM/2 

RETURN 

END 


0000207 
0000208 
0000209 
0000210 
0000211 
0000212 
0000213 
000021* 
0000215 
000021S 
0000217 
0000218 
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SUBROUTINE  NAME:  COLPNT 

Purpose:  COLPNT  outputs  the  values  of  as  many  as  20  se- 
lected items  or  expressions.  Output  is  columnar  and  is  di- 
rected to  the  terminal  or  to  a  disk  data  set. 

Calling  sequence:  CALL  COLPNT  (&n,NPAGE) 

Arguments : 

n — Statement    (in    calling   routine)    to   which    a    branch    is 
made  if  the   nonstandard   return   is   taken   from   VLIST 
(KEYBRD  senses  EOF). 
NPAGE — Number    of    lines    between    pauses    per   page   of 
terminal  output. 

Subroutines  called:  KEYBRD,  OFILE,  VLIST,  ACCESS, 
GETPUT,  PAUSE,  EVAL,  UNCODE,  BINTYP,  BLIST, 
PACK 

Common  data  referenced: 

POLISH,  ICODE,  LPS  in/EXPRNS/ 
ITYPE  in  blank  common 


Called  by:  LIST 

Error  checking  and  reporting :  None 

Program  logic: 

1.  The  user  is  asked  if  he  would  like  the  output  to  go  to  disk. 
His  reply  is  returned  by  KEYBRD.  If  affirmative  a  logical 
flag  is  set,  and  he  is  prompted  for  a  data-set  name.  This 
name  is  then  associated  with  unit  24  via  a  call  to  OFILE. 

2.  A  call  to  VLIST  returns  the  item  names  (or  expression 
pointers)  that  are  selected. 

3.  A  call  to  ACCESS  is  made  to  initialize  the  lookup  of 
character  dictionary  values. 

4.  Each  record  of  the  selected  file  is  then  obtained  via  GET- 
PUT, and  a  line  (or  record)  of  output  is  constructed.  For 
numeric  data,  a  format  is  constructed  to  maximize  the  num- 
ber of  significant  digits  displayed,  and  the  constructed  line 
is  printed. 
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SOURCE 


PROGRAM 


115 


SUBROUTINE    COLPNT (  *, NPAGE) 

COMMON    NAMES, ITYPE, IPTS, IDIM 

COMMON    /EXPRNS/    POL  I SH , I  CODE , LPS 

DIMENSION    I  TYPE (500) , B I TEM(  15 , 25  ) , ITEMS (20) ,IREC( 500) »IPTS( 500)  , 
1REC(500),    NAMES(500),     TANM25),     LABEL(25),     LISTC25I,     POLISHt 
215,8),     ICODE(15,8),     LPS(8),     IQUAL(6) 

DOUBLE    PRECISION    DBLNK , AREA, L INE ( 20  ), NAMES, LABEL , VNAMES ( 20)  , 
1    FMT(  3)  ,FMTS(  8) 

INTEGER     BLANK, TANK, YES 

LOGICAL     BLNK,TTY 

EQUIVALENCE     ( REC , I REC ) , ( I VA L, VAL) , ( TANK, L I  ST ) , (BLANK, I  QUAD 


DATA     FMT,FMTS/« ( 
•F8.4       ','F8.3 


•,«F8.6   ',^8.5 


,'F8.2 


•  ,'F8.1 

lyi   I   I 


1) 


120 


1 

2  DBLNK, YES, IQUAL/* 

TYPE  100 

CALL    KEYBRDU290,I 

TTY=I  .NE.YES 

IF(TTY)     GO    TO    115 

NPAGE=10000000 

TYPE     105 

CALL    KEYBRDU290,ITEMS,5) 

I=BLANK 

CALL    PACK( ITEMS, I, 5,5) 

CALL    0FILE(24,I ) 
KOUNT=0 

CALL    VL  1ST (£290, VNAMES,  ITEMS,NUM) 

IF     (NUM.EQ.0)    GO    TO    280 

IF(TTY)     TYPE    300,     ( VNAME S( I ) , I =1 , NUM ) 

CALL     ACCESS  (I  I,  I VAL , TANK, LK,  1 ) 

CALL    GETPUT(&270,IREC,1 ) 

K0UNT=K0UNT+1 

IF    (KOUNT.LE. NPAGE)    GO    TO    130 

K0UNT=0 

CALL     PAUSE(&270) 

TYPE  300,  ( VNAMES( I > , 1=1, NUM) 


•,(F8.0 


0000219 
0000220 
0000221 
0000222 
00002  2  3 
0000224 
0000225 
0000226 
0000227 
0000228 
0000229 
0000230 
0000231 
0000232 
0000233 
0000234 
0000235 
0000236 
0000237 
0000238 
0000239 
0000240 
0000241 
0000242 
0000243 
0000244 
00C0245 
0000246 
0000247 
0000248 
0000249 
0000250 
0000251 
0300252 
0000253 
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130  DO  26C  JJ=1,NUM  0000254 

AREA=DBLNK  00C0255 

Il=ITEMS(JJ>  0000256 

IF  (II.GT.C)  GO  TO  140  0000257 

1 1  =  — I  I  0000258 

VAL=EVAL(IREC, I  CODE (1 , I  I ) , POL ISH( 1  ,  I  I )  ,  LPS <  1 1 ) , BLNK  )  00002  59 

IF(BLNK)  GO  TO  26C  0000260 

GO  TO  160  000026  1 

140  IVAL=IREC( I  I )  0000262 

IF  { IVAL. EQ. BLANK)  GO  TO  26C  0000263 

KIND=ITYPE(  II  )  0000264 

GO  TO  ( 15Ct 160, 210, 250,205) ,  KINO  0000265 

150  ENCODE(8, 320, AREA)  IVAL  0000266 

GO  TO  260  0000267 

160  IF  (VAL.EQ.O.)  GO  TO  180  0000268 

A=ALOG10( ABS(VAL ) )  00C0269 

IF  (A.GE.5.)  GO  TO  190  0000270 

IF  (A.LE.-4.)  GO  TO  190  0000271 

IF  (A.LE.C.)  GO  TO  170  0000272 

LK=IFIX(A)+2  0000273 

GO  TO  200  0000274 

170  LK=1  0000275 

GO  TO  200  0000276 

180  LK=2  0000277 

GO  TO  200  0000278 

190  LK=8  0000279 

200  FMT(2)=FMTS(LK)  000C280 

IF(KIN0.NE.5)  10=1  0000281 

ENC0DE(9,FMT,AREA)   VAL , I QUAL ( I Q)  00C0282 

GO  TO  260  0000283 

205  VAL=UNC0DE( VAL,IQ)  0000284 

GO  TO  160  0000285 

210  CALL  ACCESS (II, IVAL, TANK, LK, 2)  0000286 

ENC0DE(8, 215, AREA)  ( TANK ( I ) , I =1 ,LK )  0000287 

GO  TO  260  0000288 

250  CALL  BINTYPd  I , LABEL , B ITEM, K , M »  0000289 

CALL  BLIST( LIST, NUMS, IVAL)  0000290 

AREA=LABEL(LIST(  1)  )  0000291 

260  LINE( JJ)=AREA  0000292 

IF(TTY)  GO  TO  65  000G293 

WRITE(24,310)  ( L INE( JJ ) , JJ=  1 , NUM)  0000294 

GO  TO  120  0000295 

65       TYPE  311, (LINE{ JJ) , JJ=l,NUM)  0000296 

GO  TO  120  0000297 

270  CONTINUE  0000298 

28C      IF(.NOT.TTY)  REWIND  24  0000299 

RETURN  0C00300 

290  RETURN  1  0000301 
100      FORMATl'  WOULD  YOU  LIKE  OUTPUT  TO  BE  TO  DISK?  (Y  OR  N):  •,$)     0000302 

1C5      FORMATC  ENTER  NAME  OF  DISK  DATA  SET  TO  BE  CREATED:  •,$)  0000303 

215      F0RMAT(A5,A3)  0000304 

30C  FORMAT  (///1X.8A10I  0000305 

310  FORMAT  ( 20A 10)  0000306 

311      FQRMAT( 1X,8A10)  0000307 

32C  FORMAT  (18)  00C0308 

END  0000309 
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FUNCTION  NAME:  COMP 

Purpose:  COMP  evaluates  a  relational  expression.  The  rela- 
tional operators  may  be  (in  FORTRAN  notation)  EQ,  LT, 
GT,  LE,  GE,  NE,  or  BE  (denoting  between).  The  evalua- 
tion is  performed  on  integer,  real,  or  binary — (that  is,  bit) 
type  data. 
Calling     sequence:     HIT    =    COMP(IVAR,IVAL,VAR,VAL, 

ICODE.ISWTCH),  where  HIT  is  of  type  LOGICAL. 
Arguments : 

IVAR,   IVAL — Integer-type  arguments  to  be   compared   if 

ISWTCH  is  1. 
VAR,     VAL — Real-type     arguments     to     be     compared     if 

ISWTCH  is  2. 
ICODE — Encoding    of    comparison    to    be    made.    Assumes 
values  1  through  7,  respectively,  indicating  the  relations 
EQ,  LT,  GT,  LE,  GE,  NE,  BE. 
ISWTCH — Indicates   the  type   of   arguments   for   the   com- 
parison (integer,  real,  or  binary). 


Subroutines  called:  None 

Common  data  referenced:  IVALS  in  /BTWN/ 

Called  by:  RETRVE 

Error  checking  and  reporting:  If  ISWTCH  is  3  (that  is, 
binary-type  arguments),  ICODE  is  tested  for  1  or  6  (EQ 
or  NE).  If  the  test  fails,  a  message  is  typed  and  COMP 
returns  FALSE  as  a  value. 

Program  logic: 

1.  The  logical  variable  NONBLK  is  set  to  indicate  nonblank 
operands. 

2.  If  ISWTCH  is  less  than  3,  the  two  operands  are  compared 
according  to  ICODE.  If  ICODE  is  7  (indicating  the  between 
operator) ,  the  operands  are  obtained  from  IVALS  in 
/BTWN/  by  use  of  IVAL  as  a  pointer  to  the  appropriate  set. 

3.  If  ISWTCH  is  3,  a  bit  (binary)  comparison  is  made  by 
examining  the  IVAL'th  bit  in  IVAR. 


GRASP 


SOURCE 


PROGRAM 


LOGICAL     FUNCTION    COMP (  I  VAR,  I VAL , V AR , VAL , I  CODE , I SWTCH )  0000310 

COMMON    /BTWN/    IVALS, NBE  0000311 

DIMENSION    IVALS(2,10),     VALS(2,10)  0000312 

LOGICAL    COMPAR, NONBLK  0000313 

EQUIVALENCE     ( I VALS(  1  , 1 )  ,  VALS ( 1  , 1 )  )  ,     (I, VI),     ( BL ANK, I BLNK )  0000314 

DATA    BLANK/'     •/  0000315 

NONBLK=IVAR.NE. I BLNK. AND. IV AL .NE. I BLNK  0000316 

IFUSWTCH-2)     5,85,165  0300317 

5    GO    TO    (10,20,30,40,50,60,70),     ICODE  0000318 

10    COMPAR=I VAR .EQ. IVAL  0000319 

GO    TO     160  0000320 

20    C0MPAR= IVAR. LT. IVAL. AND. NONBLK  0000321 

GO    TO     160  0000322 

30    COMPAR= IVAR. GT. IVAL. AND. NONBLK  0000323 

GO    TO    160  0C00324 

40    COMPAR=I VAR. LE. IVAL. AND. NONBLK  0000325 

GO    TO     160  0000326 

50    COMPAR=I VAR. GE. IVAL  .AMD. NONBLK  0000327 

GO    TO     160  0000328 

60    COMPAR= IVAR  .NE.  IVAL  0000329 

GO  TO  160  000033C 
7  0   COMPAR=I VAR.GE. IVALSd  ,IVAL) .AND. I VAH.LE. IVALS (2, IVAL ). AND. NONBLK    00003  31 

GO    TO     160  0300332 

85    NONBLK=VAR.NE. BLANK. AND. VAL. NE. BLANK  0000333 

GO    TO     (90,100,110,120,130,140,150),     ICODE  0000334 

90    COMPAR=VAR.EQ.VAL  0000335 

GO    TO     160  0000336 

100    COMPAR=VAR.LT. VAL. AND. NONBLK  0000337 

GO    TO    160  0000338 

110    COMPAR=VAR.GT. VAL. AND. NONBLK  0000339 

GO    TO     160  0000340 

120    COMPAR=VAR.LE.VAL.AND.NCNBLK  0000341 

GO    TO     160  0000342 

130    COMPAR=VAR.GE. VAL .AND. NONBLK  0000343 

GO    TO    160  0000344 

140    COMPAR=VAR.NE.VAL  0000345 

GO    TO    160  0C00346 
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150    VI=VAL  0000347 

COMPAR=VAR.GE.VALS(  It  I ) .AND . V AR. LE . VAL S ( 2 , I J.AND.NONBLK  0000348 

16C       COMP=CCMPAR  00G0349 

GO    TO     180  0000350 

165     IF(NGNBLK)    GO    TO     170  G0GO351 

IF( IC0DE.EQ.1 )    GO    TO    10  0000352 

IF( IC0DE.EQ.6)    GO    TO    60  0000353 

TYPE    200  0000354 

COMP=. FALSE.  0000355 

GO    TO     180  0000356 

170     IDIGIT=IVAR/2**(IVAL-1)  0000357 

IF  (ICODE.NE.l)  GO  TO  190  0000358 

COMP  =  MOD( I  DIG  I T.2I.E0.  1  0000359 

GO  TO  180  0000360 

190  IF  (IG0DE.NE.6)  TYPE  200  0000361 

COMP=MOD( IDIGIT.2) .NE . 1  0000362 

180  RETURN  0000363 

200  FORMAT  ( 52H  RELATION  MUST  BE  .EQ./.NE.  FOR  BINARY  TYPE  VARIABLE)   0000364 

END  0000365 
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SUBROUTINE  NAME:  CONDS 

Purpose:  CONDS  types  out  the  last  set  of  conditions  and  logic 

entered. 
Calling  sequence:  CALL  CONDS  (NCONDS.LPS) 
Arguments : 

NCONDS — The  number  of  conditions  currently  entered. 

LPS — The  length  of  the  current  logical  expression. 
Common  data  referenced:  EXPR,  LOGIC  in  /INPUT/ 


Called  by:  DRIVER 

Error  checking  and  reporting:  None 

Program  logic: 

1.  If  any  conditions  have  been  entered  (that  is,  NCOND  >0), 
they  are  typed  out. 

2.  If  a  logic  expression  has  been  entered  (that  is,  LPS  >0),  it 
is  typed  out. 
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SOURCE 


PROGRAM 


SUBROUTINE    CONDS (NCOND, LPS > 

COMMON    /INPUT/    EXPR, LOGIC 

DIMENSION    LABELS( 26) 

DOUBLE    PRECISION    EX  PR ( 4 ,26 ) , LOGIC ( 8 ) 


DATA  LABELS/'A* ,«B 

1  ,'C«  ,'D« ,' 

E','F'  ,«G«  ,' 

H«  ,•  I 

1  , 

»J' 

L',»0« ,,p,,,e,,,Rt, 

•S', »T"f 'U' 

,«V«,  »WN  'X' 

t'Y', 

»Z 

•/ 

TYPE  40 

IF  (NCOND. EQ.0)  GO 

TO  20 

DO  10  J=l, NCOND 

10 

TYPE  50,  LABELS(J) 
GO  TO  30 

,(EXPR( I, J) 

,1=1,4) 

20 

TYPE  60 

30 

IF  (LPS.NE.O)  TYPE 

RETURN 

70,  LOGIC 

40 

FORMAT  (//) 

50 

FORMAT  (4X,A1,«. 

• ,4A10) 

60 

FORMAT  (•  NO  CONDITIONS  HAVE 

BEEN  ENTERED 

YET." 

1  ) 

70 

FORMAT  (•  LOGIC  STATEMENT  IS: 

•,8A10) 

END 

K» 


0000366 
0000367 
0000368 
0000369 
N000037C 
0000371 
0000372 
0000373 
0000374 
0000375 
0000376 
0000377 
0000378 
0000379 
00003 8C 
0000381 
0000382 
0000383 
0000384 
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SUBROUTINE  NAME:  CONDTN 

Purpose:    This    subroutine    is    used    to   control    the    entry    of 
"conditions"    (see    RELEXP).    Conditions   are   entered   via 
KEYBRD,    decoded    via    RELEXP,    and    saved    (in    char- 
acter form)   in  the  common  area  named  INPUT. 
Calling  sequence:  CALL  CONDTN  (&n,VARS,CODES,VALS, 

NCOND) 
Arguments: 

n — Statement  number    (in   caller)    to  which   a  branch  will 

be  made  on  a  nonstandard  return. 
VARS — Array  of  pointers  to  items  referenced  in  the  set  of 

entered  conditions. 
CODES — Array  of  integers  giving  the  individual  relational 

operators  in  the  entered  conditions. 
VALS — Array  of  values  associated  with  the  conditions  en- 
tered. 
NCOND — Counter  giving  the  number  of  conditions  entered. 
Subroutines  called:  KEYBRD,  RELEXP,  PACK 
Common  data  referenced : 


NBE  in  /BTWN/ 

EXPR  in  /INPUT/ 
Called  by:  DRIVER 
Error   checking    and   reporting:    An   error   flag   returned    by 

RELEXP  is  tested.  If  set,  a  request  to  retype  the  condition 

is  issued. 
Program  logic : 

1.  A  letter  (A-Z)  is  printed  as  a  prompt. 

2.  The  user  response  (a  condition)  is  obtained  via  KEYBRD 
and  passed  to  RELEXP. 

3.  If  no  errors  have  been  detected  by  RELEXP,  the  user  re- 
sponse is  packed  into  AREA  and  then  moved  (first  40  char- 
acters) into  the  INPUT  common  block. 

4.  Steps  1-3  are  repeated  and  incrementally  counted  until 
an  all-blank  response  is  entered.  When  this  occurs,  execu- 
tion resumes  at  statement  40,  which  sets  the  number  of 
conditions  entered.  Control  returns  to  the  caller. 

5.  The  nonstandard  return  is  taken  if  an  EOF  is  sensed  from 
the  terminal. 
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10 


20 


30 

40 

45 
50 
60 


SUBROUTINE  CONDTN (*, VARS, CODES , VALS , NCOND ) 

0000385 

COMMON  /BTWN/  IVALS,NBE 

0000386 

COMMON  /INPUT/  EXPR, LOGIC 

0000387 

DOUBLE  PRECISION  E XPR< 4  ,26 ) , AREA (4 )  ,  LOGIC (8 ) 

0000388 

INTEGER  IMAGE ( 80), VARS <  1),VALS( I) ,C0DES(  1), IVALS(2,10> , PROMPT (26) 

0000389 

LOGICAL  ERR 

0000390 

DATA  PROMPT/ 'A. • , • B. • , »C. ■ , • D. • , • E. » , • F. ■ , • G. • , • H. ■ « • I • • , • J. • , «K. 

•0000391 

l,,L.,,,M.,,,N.',,0.,,,P.,,,Q.,,,R.,,,S.,,,T.f,,U.,,,V.,,,W.»,,X.« 

,0000392 

2«Y.  •,  'Z.V 

0000393 

NBE  =  0 

0000394 

J=l 

0000395 

TYPE  50,  PROMPT(J) 

0000396 

CALL  KEYBRD(£45, IMAGE, 80) 

0000397 

CALL  RELEXP (£40,  IMAGE, VARS (J  ),C0DES(J) , VALS( J ) , ERR ) 

0000398 

IF  (ERR)  GO  TO  30 

0000399 

CALL  PACK(IMAGE,AREA,40,40) 

0000400 

DO  20  1=1,4 

0000401 

EXPR( I , J)=AREA( I) 

0000402 

J  =  J+1 

0000403 

GO  TO  10 

00004  04 

TYPE  60 

0000405 

GO  TO  10 

0000406 

NC0ND=J-1 

0000407 

RETURN 

0000408 

RETURN  1 

0000409 

FORMAT  (1X,A3,$) 

0000410 

FORMAT  (•  RE-TYPE  CONDITION1 ) 

0000411 

END 

0000412 
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SUBROUTINE  NAME,  DECOMP 

Purpose:  DECOMP  extracts  a  list  of  item  names  and  a  cor- 
responding list  of  item  numbers  from  an  unpacked  character 
string. 

Callng  sequence:  CALL  DECOMP  (&l,&m,IMAGE,NLIST, 
LIST,N) 

Arguments : 

1 — Statement   (in  caller)   which  will  be  branched  to  if  an 

invalid  item  name  is  detected, 
m — Statement   (in  caller)   which  will  be  branched  to  if  the 

input  string  contains  no  item  names. 
IMAGE — Unpacked  input-character  string. 
NLIST — List  of  item  names  (offset  by  one  from  LIST) . 
LIST — A  function  name  followed  by  a  list  of  item  numbers. 
N — Total  number  of  items  in  LIST. 

Subroutines  called:  BFIND,  PACK 

Common  data  referenced:  NAMES,  IPTS,  IDIM  in  blank 
common 

Called  by:  FTNC 

Error  checking  and  reporting:  BFIND  takes  the  nonstandard 
return  if  a  name  is  not  found.  This  causes  an  error  message 
to  be  typed  and  a  new  input  to  be  requested.  If  a  comma 


is  detected  before  the  list  of  item  names  begins,  a  message 
is  typed  and  new  input  is  requested. 

Program  logic:  The  input-string  IMAGE  is  scanned,  a  char- 
acter at  a  time,  via  a  transition  matrix.  The  list  of  names 
is  created  and  the  list  of  item  numbers  is  obtained  via  calls 
to  BFIND.  The  following  transition  matrix  is  used: 


blank 
f(0)/l 
f(2)/3 
f(0)/3 
f(2)/3 


comma 
error 
error 
f(0)/3 
f(2)/3 


IMAT    (4,  3) 

nonblank 

f(D/2 
f(0)/2 
f(3)/4 
f(0)/4 


purpose 
start  function  name 
find  end  of  function  name 
start  item  name 
find  end  of  item  name 


where  the  f  (i)  are: 

f(0) — No  operation. 

f  ( 1 )  — Mark  first  character. 

f(2) — Mark  last  character.  Pack  and  find  index  of  item 

name  (that  is,  find  item  number) . 
f(3) — Increment  list  item  counter  and  mark   first  char- 
acter of  new  list  item. 
The  entire  input  stream  is  scanned,  and  control  is  returned 
to  caller.  Refer  to  program  logic  section  of  LOGEXP  for  a 
more  complete  discussion  of  transition-matrix  parsing. 
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12,2,34,4/ 


SUBROUTINE    DECOMP ( *,*,  IMAGE ,NLI  ST , LI  ST ,N) 

COMMON    NAMES,  ITYPE,  IPTS,  IDIM 

DIMENSION    ITYPE(500),     IMAGE{     1),     LIST(l),     IPTS(500), 

DOUBLE    PRECISION    N AME S ( 50C ) ,NAME,DBLNK ,NLI ST( 5) 

EQUIVALENCE     (INAME,NAME) 

DATA     DBLNK,IBLNK,ICOMMA/' 

DATA    IMAT/1,23,3,23,2*40,  3,  23, 

N  =  l 

IR0W=1 

DO    90     1=1, 8G 

IF     UMAGEd  ).EQ.IC0MMA)     GO    TO    10 

IF    ( IMAGE( I J.NE.IBLNK)     GO    TO    20 

IVAL=IMAT (IROW, 1) 

GO    TO    30 
10    IVAL= IMAT(IP0W,2) 

GO    TO    30 
20    I VAL=IMAT(IR0W,3) 
30    IROW=M0D(  IVAL,  10) 

J0B=I VAL/10+1 

GO    TO     (90,50,70,40,120),     JOB 
40    N=N+i 
50    IC=I 

GO    TO    90 
70    LC=I-1 

NAME=DBLNK 

CALL    PACK (IMAGE! IC) , NAME ,LC-I C+ 1 , 8 ) 

IF    (N.GT.ll    GO    TO    80 

LI ST(  1)=INAME 

GO  TO  90 
80  CALL  BFIND(G100, NAME, L IST(N), NAMES,  IPTS, IDIM) 

NLI ST(N-1)=NAME 


IMAT(4,3) 


0000413 
0000414 
0000415 
0000^16 
0000417 
0000418 
0000419 
0000420 
0000421 
0000422 
0000423 
0000424 
0000425 
0C00426 
0000427 
0000428 
0000429 
0000430 
0000431 
0000432 
0000433 
0000434 
0000435 
0000436 
0000437 
0000438 
0C00439 
0000440 
0000441 
0C00442 
0000443 
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90  CONTINUE  0000444 

IF  (N.EQ.l)  RETURN  2  0000*45 

RETURN  0000446 

100  TYPE  140t  NAME  0000447 

110  RETURN  1  0000448 

120  TYPE  150t  IMAGE(I)  0000449 

GO  TO  110  0000450 

140  FORMAT  (1X,A8,'IS  AN  INVALID  NAME.  RE-ENTER  LINE.1)                 0000451 

150  FORMAT  (•  PUNCTUATION  ERROR  CAUSED  BY  •,Al,«.  RE-ENTER  LINE.')     0000^52 

END  0000453 
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SUBROUTINE  NAME:  DEFINE 

Purpose:  DEFINE  is  used  to  define  the  structure  and  name 
of  a  direct-access  disk-data  set  having  fixed-length  records. 
Individual  records  may  then  be  directly  accessed  by  specify- 
ing the  record  number. 
Calling  sequence:  CALL  DEFINE (U,S,V,F,PJ,PG) 
Arguments: 

U — The  FORTRAN  unit  number  expressed  as  an  integer. 
S — The  size  of  the  records  within  the  file,  expressed  as  an 
integer.  For  formatted  records,  S  gives  the  number  of 
characters  per  record.  For  unformatted  records,  S  gives 
the  number  of  words  per  record. 
V — The  associated  integer  variable.  The  record  number 
which  would  be  accessed  next  if  I/O  were  to  continue 
sequentially  is  returned  as  an  integer  in  the  associated 
variable  after  each  random  read  or  write. 


F — The  name  of  the  file  which  will  be  accessed  when  an  1/ 

O  statement  references  U    (the  above  unit  number). 
PJ — The  project  number  in  octal  of  the  disk  area  in  which 

the  file  resides. 
PG — The  programmer  number  in  octal  of  the  disk  area  in 
which  the  file  resides. 

Subroutines  called:  None 

Common  data  referenced :  None 

Called  by:  FILES 

Error  checking  and  reporting :  None 

Program  logic:  This  is  a  DEC  1070,  TOPS-10  system  resi- 
dent routine.  It  provides  the  capabilities  referred  to  in  the 
Purpose  section  above.  If  the  GRASP  system  is  to  be  im- 
plemented on  some  other  main  frame,  a  comparable  routine 
must  be  written  or  acquired.  No  listing  is  shown  here. 
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SUBROUTINE  NAME:  DEFLST 

Purpose:  DEFLST  outputs  the  category  names  to  the  user  and 

allows  him  to  indicate  which  categories  are  of  interest. 
Calling   sequence:    CALL    DEFLST (&m,&n,CAT,NUMC,MC, 

LIST) 
Arguments : 

m — Statement  (in  calling  routine)  that  will  be  branched  to 
if  no  category  numbers  are  given  when  asked  for. 

n — Statement  (in  calling  routine)   that  will  be  branched  to 
if  an  EOF  is  sensed  in  KEYBRD. 

CAT — Contains  the  category  names  as  read  from  unit  20 
(the  "definitions  file") . 

NUMC — Number  of  categories  selected  by  the  user. 

MC — Maximum  length  in  words  of  a  category  name. 

LIST — The  category  numbers  selected. 
Subroutines  called:  IFILE,  KEYBRD,  LENGTH,  RLIST 
Common  data  referenced:  FNAMES,  WHICH  in  /FILNAM/ 
Called  by:  NAME,  DUMPIT 


Error  checking  and  reporting:  All  user  response  is  checked 
for  validity.  If  errors  are  detected,  the  response  is  requested 
again. 

Program  logic: 

1.  A  call  to  IFILE  associates  the  "definitions"  file  name  with 
FORTRAN  unit  20,  and  the  category  names  are  read  from 
this  file. 

2.  The  user  is  asked  if  he  is  interested  in  all  categories.  His 
response  is  checked  against  "Y"  or  "N."  If  invalid,  an 
error  message  is  typed,  and  he  is  asked  to  respond  again. 

3.  If  the  user's  response  was  "Y,"  LIST  is  set  to  all  the 
category  numbers  and  control  is  returned  to  the  calling 
routine. 

4.  If  the  response  was  "N,"  the  user  is  asked  to  enter  a  list 
of  category  numbers  of  interest. 

5.  His  response,  contained  in  IMAGE,  is  passed  to  RLIST  to 
generate  the  values  of  LIST. 
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40 


45 


10 


20 


85 
90 

100 
30 
35 

110 


SUBROUTINE    DEFLST ( * , * , CAT , NUMC , MC , L I  ST  ) 

COMMON    /FILNAM/     FN  AM ES , WH ICH, PAD 

INTEGER    CAT(8,1     ) , L I  ST ( 1 ) , I MAGE( 30 ) , FN  AM ES ( 21 ) , WH  ICH, PAD (4 ) 

DATA     IYES,NO/»Y', »N«/ 

CALL     IFILE(20,FNAMES(8+WHICH)  ) 

READ    (20)    NCAT,MC, ( (CATC  I ,J) ,1=1  ,MC) ,J=1,NCAT) 

TYPE    30 

CALL    KEYBRDU100,  1,1) 

IF(  l.EQ.IYES)    GO    TO    40 

IF(I.EO.NO)     GO    TO     5 

TYPE    35 

GO    TO    2  5 

NUMC=NCAT 

DO    45     1=1, NUMC 

LIST( I )=I 

GO   TO    85 

TYPE     110 

DO    10    J=1,NCAT 

CALL    LENGTH (CAT (1, J ) , MC , MCL ) 

TYPE     120,    J,(CAT( I , J) ,  1  =  1 ,MCL) 

TYPE     130 

CALL    KEYBRDtClOO, IMAGE, 30 ) 

CALL    RLIST( &20, I  MAGE , L I  ST , NUMC ,NC AT ) 

IF    (NUMC.EQ.0)     GO    TO    90 

RETURN 

RETURN     1 

RETURN    2 

F0RMAT( 

FORMATt 

FORMAT 


•  SHALL    ALL    CATEGORIES    BE    CONSIDERED?    (YES 

•  YOUR    REPLY    WAS    NOT    UNDERSTOOD.') 
(•     EACH    RECORD    HAS    BEEN    DIVIDED    INTO 

1AL    CATEG0RI  ES:'  /8X,«CAT.    #       CAT.    NAMEV8X,' 
120    FORMAT     (10X,I2,4X, 9A5) 
130    FORMAT     (•     ENTER    A    LIST    OF    ASCENDING    NUMBERS 

10RIES    OF     INTEREST*/'     (IE.     1,3,5    OR    2-5)') 
END 


OR  NO) 


THE  FOLLOWING  ', 


MATCHING 


•YOUR 


0000454 
0000455 
0000456 
0000457 
0000458 
0000459 
0000460 
0000461 
0C00462 
0000463 
0000464 
0000465 
0000466 
0000467 
0000468 
0000469 
0000470 
0000471 
0000472 
0000473 
0000474 
00C0475 
0000476 
0000477 
0000478 
0000479 
0000480 
$>  0000481 
0000482 
•GENER00C0483 
•  )  0000484 
0000485 
CATEG0000486 
0000487 
0000488 
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SUBROUTINE  NAME:  DUMPIT 

Purpose:  DUMPIT  outputs  to  the  terminal  those  values  for 
all  items  present  in  a  set  of  user-selected  categories.  The 
values  are  obtained  from  a  user-selected  file. 

Calling  sequence:  CALL  DUMPIT 

Arguments :  None 

Subroutines  called:  OPREP,  DEFLST,  FINDGP,  ACCESS, 
GETPUT,  PAUSE,  LENGTH,  UNCODE,  BINTYP, 
BLIST 

Common  data  referenced: 
NFILE  in  /IOUNIT/ 
NAMES,  ITYPE  in  blank  common 

Called  by:  DRIVER 

Error  checking  and  reporting :  None 

Program  logic: 

1.  Page  size  (NPAGE),  input  file  name,  and  file  unit  are 
set  up  by  a  call  to  OPREP. 

2.  A  call  to  DEFLST  is  made  to  determine  categories  to  be 
dumped. 

3.  Calls  to  FINDGP  are  made  to  determine  pointers  (KLIST) 
for  those  items  in  the  selected  categories.  As  DEFLST  and 
FINDGP  used  FORTRAN  unit  20,  the  "definitions"  file 
for  the  current  data  base,  the  unit  is  rewound. 


4.  A  call  to  ACCESS  is  made  to  initialize  character  dictionary 
lookups. 

5.  Each  record  in  the  input  file  is  obtained  by  GETPUT,  the 
selected  items  are  tested  for  nonblank  characters,  and  their 
value  is  output. 

6.  The  output  algorithm  is  basically  as  follows: 

(a)  Determine  item  type  and  switch  to  appropriate  code 
section  via  a  computed  GOTO. 

If  type  is  integer,  print  under  an  I  format. 

If  type  is  real,  print  under  a  G  format. 

If  type  is  character,  obtain  string  value  by  a  call  to 
ACCESS  and  print  under  an  A  format. 

If  type  is  multiple  choice,  obtain  possible  values  by  a 
call  to  BINTYP,  and  select  the  actual  subset  via  a 
call  to  BLIST.  Print  this  subset  under  an  A  format. 

If  type  is  qualified  real,  obtain  value  and  qualifier  via 
a  call  to  UNCODE.  Print  under  a  G  and  A  format. 

After  each  line  is  printed,  increment  and  test  KOUNT 
against  page  size.  If  KOUNT  is  greater  than  page 
size,  call  PAUSE  for  a  programmed  pause  and  re- 
initialize KOUNT  to  zero. 

After  each  record  has  been  processed,  print  a  line  of 
asterisks  as  a  record  separator. 


(b) 
(c) 
(d) 

(e) 


(f) 
(g) 


(h) 
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SOURCE 


PROGRAM 


10 


20 


40 


SUBROUTINE    DUMPIT 
COMMON    NAMES,  ITYPE, IPTS,  IPAD 
COMMON    /IOUNIT/    NFILE, IOF 

DIMENSION    ITYPE(500),    B  I  TEM(  15  ,  25)  ,     IREC(500),     IQUAU6), 
I  REC(500),     TANK(25),     LABEU25),     LIST(25> 

DOUBLE    PRECISION    LABEL , NAMES  I t    NAMES(50C) 
INTEGER    TANK,CAT(8,17) ,KLIST( 17) , SELECT ( 500 ) , IPTS (500) 
LOGICAL     PNTHDG,NEWCAT,HIT 

EQUIVALENCE     ( REC  ,  I R EC ) , (  I VAL , VAL ) ,  (T ANK ,L 1ST ) , ( IBLNK, I QUAL ) 
DATA    I0UAL/'     • , *G* ,  '  H  • , • L • , • N«  ,' T1  / 
KOUNT =0 

CALL     0PREP(£200,6205, NPAGE) 
CALL     DEFLST (£200, & 200, CAT,NUMC ,MC, KLIST) 
NT0T=0 

DO    20    K=1,NUMC 

CALL  FINDGP(&200,KLIST(K) , I , J ,N& , I REC) 
READ  (20) 
DO  10  1=1, NG 
NT0T=NT0T+1 

SELECT(NT0T )=2*IREC(  I) 

SELECT(NT0T-NG+1)=SELECT(NT0T-NG+1 )*1 
CONT INUE 
REWIND  20 

CALL  ACCESS( II , I VA L , TANK, J, 1 > 
CALL  GETPUT(£200,IREC, 1) 
HIT=. FALSE. 
KNT  =  0 

DO  190  JJ=1,NT0T 
II=SELECT(JJ)/2 
NEWCAT=SELECT( JJ).NE.2*I I 
IF  (NEWCAT)  KNT=KNT+1 
PNTHDG=PNTHDG.OR.NEWCAT 


0000489 
000049C 
0000491 
0000492 
0000493 
0000494 
0000495 
0000496 
0000497 
0000^98 
0000499 
0000500 
0000501 
0000502 
0000503 
0000504 
00C0505 
0000506 
0000507 
0000508 
0000509 
0000510 
0000511 
0000512 
3000513 
0000514 
0000515 
00C0516 
C000517 
0000518 
0000519 
0000520 
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NAMESI=NAMES( II )  0000521 

IVAL  =  IREC( I  I >  00C0522 

IF    ( I VAL.EQ.IBLNK)     GO    TO    190  00C0523 

HIT=.TRUE.  00C0524 

KOUNT=KOUNT+l  0000525 

IF    (KOUNT.LE.NPAGE)     GO    TO    50  0000526 

KOUNT=0  0000527 

CALL     PAUSEU200)  0000528 

50    KIND=ITYPE( II )  0000529 

IF( .NOT.PNTHDG)    GO    TO    55  0000530 

KL=KLIST(KNT)  0000531 

CALL  LENGTH(CAT( 1,KL) ,MC,MCL)  0000532 

TYPE  210, (CAT( I,KL),  1=1, MCL )  0000533 

PNTHDG=. FALSE.  0000534 

55       GO  TO  (60, 70,80,  170,  160) , KIND  0000535 

60  TYPE  230,  NAMESI,IVAL  0000536 

GO  TO  190  0000537 

70  TYPE  240,  NAMESI,VAL  0000538 

GO  TO  190  0000539 

80  CALL  ACCESSU  I  ,IVAL,TANK,  J, 2)  0000540 

TYPE  250,  NAMESI,( TANK ( I  )  ,1  =  1, J)  0000541 

GO  TO  190  0000542 

160  VAL=UNCODE( VAL,IQ)  0000543 

TYPE  240,NAMESI,VAL,  IQUAL(  IQ)  0000544 

GO  TO  190  0000545 

170  CALL  BINTYP (II , LABEL, B ITEM,K,M)  0000546 

KCUNT=K0UNT+1  0000547 

TYPE  250,  NAMESI  0000548 

CALL  BL  IST(L  1ST, MUMS, IVAL)  0000549 

DO  180  I=1,NUMS  0000550 

J=LIST(I)  0000551 

180  TYPE  260,  L ABEL ( J ) , ( B ITEM( L , J  )  ,L= 1 ,K)  0000552 

190  CONTINUE  0000553 

IF  (HIT)  TYPE  220  0000554 

GO  TO  40  0000555 

200  REWIND  NFILE  0C00556 

REWIND  20  0000557 

205      RETURN  0000558 

210  FORMAT  (•  CATEGORY:  «,8A5)  0000559 

220  FORMAT  ( IX, 3( 8H******** ) )  0000560 

230  FORMAT  (2X , A8, 1 X, 19 )  0000561 

240  FORMAT  ( 2 X, A  8 , 1 X , 1 PG12 . 5  , Al )  0000562 

250  FORMAT  ( 2X, A8, IX, 12A 5/ 1 IX , 12A 5)  0000563 

260  FORMAT  (5X,A8,15A4)  0000564 

END  0000565 
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FUNCTION  NAME:  EVAL 

Purpose:    By  using  a   particular  set  of   values   as   operands, 
EVAL   evaluates   a   previously    parsed   Reverse-Polish-form 
arithmetic  expression. 
Calling    sequence:     VAL  =  EVAL(VALUES,TYPE,POLISH, 

I,BLNK) 
Arguments : 

VALUES — Set  of  operand  values. 

TYPE,   POLISH — Arrays  containing  the  encoded  Reverse- 
Polish  form  of  the  expression  to  be  evaluated.  The  encod- 
ing is  as  follows:  Let  ITY  be  the  I'th  element  of  TYPE. 
If   ITY  =  0,   the   I'th   element   of    POLISH   is   a   numeric 
constant.    If    ITY>0,    ITY    is    an    index    to    the    array 
VALUES.  If  ITY<0,  ITY  corresponds  to  an  arithmetic 
operator  or  function. 
I— Gives  the  length  of  the  arrays  TYPE  and  POLISH. 
BLNK — Logical  variable  set  to  TRUE  if  any  operand  with 
a  blank  value  is  sensed. 
Subroutines  called:  UNCODE 
Common  data  referenced:  ITYPE  in  blank  common 


Called  by:  COLPNT,  ROWPNT 
Error  checking  and  reporting : 

1.  Division  by  zero  attempted. 

2.  Log  of  a  nonpositive  value  attempted. 

3.  Square  root  of  a  negative  value  attempted. 

Program  logic:  A  push-down  stack  technique  is  used  to  evalu- 
ate the  Reverse-Polish  string  contained  in  TYPE  and  POL- 
ISH. TYPE  is  scanned,  an  element  at  a  time,  pushing 
operand  values  down  on  the  stack  until  an  operator  is 
sensed.  Either  the  top  or  topmost  two  stack  elements  are 
then  used  as  operands  resulting  in  a  new  topmost-stack 
element  which  is  the  resulting  value  of  the  operator.  Unary 
operators/functions  (absolute  value,  ABS;  square  root, 
SQRT;  logarithm,  LOG;  square,  SQR;  ten  exponent,  TEN: 
minus,  — )  operate  on  the  top  stack  element.  Binary  opera- 
tors (+,  — ,  *,  /)  operate  on  the  topmost-two  stack  elements. 
After  all  elements  of  TYPE  have  been  processed,  the  stack 
should  have  one  value  in  it.  This  value,  the  result,  is  re- 
turned. If  a  blank  operand  value  is  detected,  the  flag  BLNK 
is  turned  on  and  zero  is  returned. 


GRASP 


SOURCE 


PROGRAM 


FUNCTION    EVAL (VALUES, TYPE, POLISH, I , BLNK) 

COMMON    NAMES, ITYPE, IPTS,IPAD 

DIMENSION    NAMES(500),     VALUES(l),    POLISH(l), 
1YPE(500) ,IPTS(500) 

DOUBLE    PRECISION    NAMES 

INTEGER    TOP, TYPE, VALUES 

LOGICAL    BLNK 

EQUIVAL  ENCE    ( VAL,  IVAL) 

DATA     IBLNK/'     '/ 

BLNK=. FALSE. 

TOP=0 

DO    190    J=1,I 

INDEX=TYPE( J) 

IF  (INDEX)  40,30,10 
10  T0P=T0P+1 

IVAL=VALUES( INDEX) 

IF     (I VAL. E0. IBLNK )    GO    TO    195 

IF    ( ITYPE( INDEX). EQ. 2)     GO    TO    15 

IF(  ITYPE(  INDEX) .NE .5)    GO    TO    20 

VAL=UNC0DE(VAL, IQ) 
15    STACM  TOP)  =  VAL 

GO    TO    190 
20    STACK(TOP)=IVAL 

GO    TO     190 
30    T0P=T0P+1 

STACK(TOP)=POLISH(  J) 

GO  TO  190 
40  IF  ( INDEX. GE. -4)  GO  TO  130 

INDEX=INDEX+11 

GO  TO  (50,60,80,100,110,120),  INDEX 
50  STACK(TOP)=ABS(STACK(TOP)  ) 

GO  TO  190 


STACM41),  TYPE(l) 


0000566 
0000567 
IT0000568 
0000569 
0000570 
0000571 
0000572 
0000573 
0000574 
0000575 
0C0O576 
0000577 
0000578 
000C579 
0000580 
0000581 
0000582 
0000583 
0000584 
0000585 
0000586 
0000587 
0000588 
0000589 
000059C 
0000591 
0000592 
00C0593 
0000594 
0000595 
0000596 
0000597 
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60 

70 

80 

90 
IOC 
110 
120 
130 

140 
150 

160 

170 

180 
190 


195 
200 
210 
220 
230 
240 


TV=STACK(TOP) 

IF  (TV.GE.O.)  GO  TO  70 

TYPE  230 

GO  TO  200 

STACK (TOP)=SQRT (TV ) 

GO  TO  190 

TV=STACK(TOP) 

IF  ( TV.GT.O.)  GO  TO  90 

TYPE  220 

GO  TO  200 

STACK(TOP)=ALOG10(TV) 

GO  TO  190 

STACK(TOP)=STACK(TOP)**2 

GO  TO  190 

STACK(T0P)=10.**STACK(T0P) 

GO  TO  190 

STACK ( TOP )=- STACK! TOP) 

GO  TO  190 

INDEX=INDEX+5 

VT=STACK(TOP) 

T0P=T0P-1 

GO  TD  ( 150» 140tl80,17C) ♦  INDEX 

STACK(TOP)=STACK(TOP)*VT 

GO  TO  190 

IF  (VT.NE.O.O)  GO  TO  160 

TYPE  240 

GO  TO  200 

STACK (TOP  )=STACK(TOP)/VT 

GO  TO  190 

STACK ( TOP )=STACK( TOP)+VT 

GO  TO  190 

STACK(TOP)=STACK(TOP)-VT 

CONTINUE 

IF  (TOP  .NE.  1)  GO  TO  200 

EVAL=STACK( 1) 

GO  TO  210 

BLNK=.TRUE. 

EVAL=0.0 

RETURN 

(•  ATTEMPTED  TO  TAKE 
( •  ATTEMPTED  TO  TAKE 
( •  DIVIDE  BY 


FORMAT 
FORMAT 
FORMAT 
END 


LOG  OF  A  ZERO  OR  NEG.  VALUE.1) 
SORT  CF  A  NEGATIVE  VALUE.') 


ZERO  ATTEMPTED . • ) 


0000598 

0000599 

OG00600 

0000601 

0000602- 

0000603 

0000604 

0000605 

0000606 

0000607 

0000608 

0000609 

0000610 

0000611 

0030612 

0C00613 

0000614 

0D00615 

0000616 

0000617 

0000618 

0000619 

0000620 

0000621 

0000622 

0000623 

0000624 

0000625 

0000626 

0000627 

0000628 

0000629 

0000630 

0000631 

0000632 

0000633 

0000634 

0000635 

0000636 

0000637 

0000638 

0000639 

0000640 
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SUBROUTINE  NAME:  FDRIVE 

Purpose:  FDRIVE  provides  for  the  single-pass  computation 
of  all  implemented  mathematical  or  statistical  functions.  Us- 
ing this  routine  to  make  all  calls  to  the  subroutines  cor- 
responding to  implemented  functions  simplifies  the  addition 
of  new  functions. 

Calling  sequence:  CALL  FDRIVE  (IS WTCH) 

Arguments : 

ISWTCH — Integer  code   passed  to  called   subroutines   indi- 


cating phase  1,  2,  or  3.  The  phases  are  initialization,  body, 

and  postprocessing. 
Subroutines  called:  MEAN,  FIT 
Common  data  referenced:  None 
Called  by:  FTNC 

Error  checking  and  reporting:  None 

Program  logic:  This  routine  merely  makes  calls  to  the  func- 
tions selected  by  the  user  via  computed  GOTO. 


GRASP 


SOURCE 


PROGRAM 


10 

20 
30 


SUBROUTINE    FDRIVE ( I SWTCH ) 

COMMON    /FTNCOM/    TAGS , I REC , ARGS , NAR GS , I  FT N, NFT N 

DOUBLE    PRECISION    TAGS(5,5) 

INTEGER    ARGS (6,5),  NARGS(5  ),  IFTN(5) ,  IRECI 500) 

DO    30    J=1,NFTN 

I=IFTN(  J  ) 

GOTO    (10,20,30,30,30,30),     I 

CALL  MEAN( J, I SWTCH) 

GO  TO  30 

CALL  FIT( J, ISWTCH) 

CONTINUE 

RETURN 

END 


0000641 
0000642 
0000643 
0000644 
0000645 
0000646 
0000647 
0000648 
0300649 
0000650 
0000651 
0000652 
0000653 
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SUBROUTINE  NAME:  FILES 

Purpose:  FILES  prompts  for  and  accepts  a  data-base  name. 
After  the  name  has  been  provided  and  verified,  the  Mask 
file  of  data-base  characteristics  associated  with  that  name  is 
read.  Some  preliminary  processing  is  done  on  these  char- 
acteristics. 

Calling  sequence:  CALL  FILES (&n) 

Argument: 

n — Statement  (in  caller)  to  which  a  branch  is  made  if  the 
nonstandard  return  from  KEYBRD  is  taken  (namely,  an 
EOF  is  sensed). 

Subroutines  called:  KEYBRD,  IFILE,  BINIT,  DEFINE, 
PACK 

Common  data  referenced: 

NAMES,  ITYPE,  IPTS,  IDIM  in  blank  common. 
MASTER,  MASK,  DFILE,  BFILE,  NUMF,  NUMI,  IDIMS 
in  /FILNAM/. 
I,  IDPTin  /DACOMM/. 

Called  bij:  DRIVER 


Error  checking  and  reporting:  The  data-base  name  entered  by 
the  user  is  compared  with  the  list  (MASTER)  of  those 
available.  If  the  data-base  name  is  not  recognized,  an  error 
message  is  typed. 

Program  Logic: 

1.  A  data-base  name  is  prompted  for  and  accepted  via  KEY- 
BRD, and  is  then  packed  into  FILEID  and  compared  with 
the  list  (MASTER)  of  available  names.  If  not  found,  an 
error  message  and  the  list  of  available  names  is  typed  fol- 
lowed by  a  prompt  for  another  name. 

2.  Once  the  data  base  has  been  established,  its  corresponding 
Mask  file  is  read  to  fill  the  blank  common  area. 

3.  The  item  names  from  MASK  are  sorted  via  a  call  to 
BINIT  and  the  array  of  pointers  (IPTS)  to  the  sorted 
NAMES  is  returned  from  BINIT. 

4.  NAMES  is  restored  to  its  unsorted  form  and  DEFINE 
is  called  to  associate  the  name  of  the  direct-access  character 
dictionary  with  unit  21.  IFILE  is  then  called  to  associate 
the  name  of  the  multiple-choice  file  with  unit  22. 
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SOURCE 


PROGRAM 


1C 


20 


999 

4 


SUBROUTINE    FILES(*) 

COMMON    NAMES, ITYPE, IPTS  ,IDI M 

COMMON    /FILNAM/    M A STER , MASK , DEFTN , DF I L E , BF I LE , NUMF , NUM I , I DI MS 

COMMON    /DACOMM/     I , I  DPT 

DIMENSION    ITYPE(500),     IPTS(5G0>,     IDPT(5C0>,     IDIMS(4) 

DOUBLE    PRECISION    N AMES ( 500 >, VNAMES ( 500 ) 

INTEGER    M AS TER(4),MASK(4), DEFTN (4) ,DFILE(4),BFILE(4), FILEID 

DATA     120,121,122/20,21,22/ 

TYPE     11 

CALL    KEYBRD(&999,ITYPE,5) 

CALL    PACK(ITYPE,FILEID,5,5) 

DO    3    J=1,NUMF 

IF(MASTER( J).EQ. FILEID)    GO    TO    5 

CONTINUE 

TYPE    4, FILEID, (MASTERl I  ), 1=1, NUMF) 

GO    TO     1 

NUMI=J 

CALL     IFILE( I20,MASK(NUMI  )  ) 

IDIM= IDIMS( NUMI ) 

READ(  1 20)  (  ITYPE(  I ), I=1,IDIM),(IDPT(I )  ,1  =  1, IDIM) , 
1    (NAMES! I ) ,1=1, IDIM) 

REWIND    120 

DO    10     1=1, IDIM 

VNAMESU  >=NAMES(  I) 

CALL    BINITI NAMES, IPTS, IDIM) 

DO    20     1=1, IDIM 

NAMES(  I  )=VNAMES( I ) 

CALL     DEFINE(  121,2  7,  I,  DFILE  (NUMI  ) ,  ••  412,  "  1  76) 

CALL     IF  ILE  < 122, BFILE(NUMI ) ) 

RETURN 

RETURN     1 

FORMATdX  ,A6,«N0T  AN  AVAILABLE  DATA  BASE  NAME.  ', 
1     'USE    ONE    OF    THE    F OLLOW I NG : • / ( 1 X , A 5) ) 


11 


F0RMAT( 
END 


•  ENTER  DATA  BASE  NAME 


$) 


0000654 
0000655 
0000656 
00G0657 
0000658 
0000659 
0000660 
0000661 
0000662 
0000663 
0000664 
0000665 
0000666 
0000667 
0000668 
0000669 
0000670 
0000671 
0000672 
0000673 
0000674 
0000675 
0000676 
0000677 
0000678 
0000679 
0000680 
0000681 
0000682 
0000683 
0000684 
00G0685 
0000686 
0000687 
0000688 
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SUBROUTINE  NAME:  FIND 

Purpose:  FIND  is  used  to  look  up  a  word  in  a  "hash  coded" 

table   and   return   a  code   associated  with   its  position.   The 

"Linear  quotient"  technique,  as  described  by  Bell  and  Kaman 

(1970),  is  used. 
Calling  sequence:  CALL  FIND   (&n,ISYMBL,KODE,CHARS, 

CODES,M) 
Arguments : 

n — Statement    (in   caller)    to   which   a   branch   is   taken   if 
ISYMBL  is  not  in  CHARS. 

ISYMBL— Word  to  be  looked  up. 

KODE — Integer  from  the  position  in  CODES  corresponding 
to  the  position  of  ISYMBL  in  CHARS. 

CHARS — "Hash  coded"  table  of  words  to  be  looked  up. 


CODES — Table  corresponding  to  CHARS  giving  the  original 

position  of  the  word  to  be  looked  up. 
M— Table  size  (a  prime  number)   for  CHARS  and  CODES. 

Subroutines  called:  None 

Common  data  referenced:  None 

Called  by:  LOGEXP,  PARSE 

Error  checking  and  reporting:  If  ISYMBL  is  not  in  CHARS, 
the  nonstandard  return  is  taken. 

Program  logic:  An  initial  location  I  and  displacement  J  is 
determined  from  the  internal  machine  representation  of  the 
word  stored  in  ISYMBL.  Initial  and  successive  probes  to 
CHARS  are  made  until  an  empty  location  is  probed.  If 
ISYMBL  is  not  in  CHARS,  the  nonstandard  return  is  taken. 
If  ISYMBL  is  found  in  CHARS,  the  corresponding  element 
of  CODES  is  returned  in  KODE. 


GRASP 
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PROGRAM 


SUBROUT  INE    FINDC  *,  ISYMBL, KODE , CHARS, CODES ,M» 

INTEGER    CHARS(l) ,CODES(l), FILLER 

DATA    FILLER/'VOID1/ 

L=IABS( ISYMBL) 

J=L/M 

I=L-M*J 

IF     (M0D(J,M J.EQ.O)    J=l 
5C     ICHAR=CHARS( I+ll 

IF     (  ICHAR.EO. ISYMBL)     GO    TO    60 

IF     (ICHAR.EQ. FILLER)    RETURN     1 

I=M00(H-J,M) 

GO    TO    50 
60    KODE  =  CODES(  1  +  1) 

RETURN 

END 


0000689 
0000690 
0000691 
0000692 
C000693 
0000694 
0000695 
0000696 
00C0697 
0000698 
0000699 
0000700 
0000701 
0000702 
0000703 
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SUBROUTINE  NAME:  FINDGP 

Purpose:  FINDGP  positions  the  file  associated  with  FORTRAN 

unit  20  to  a  particular  record  paid  associated  with  a  category. 

Data  concerning  that  category  are  returned  to  the  caller. 
Calling     sequence:   CALL   FINDGP (&n,KNUM,NUM,MAXL, 

NG.GROUP) 
Arguments: 

n — Statement  number  (in  caller)   to  which  control  is  passed 
if  an  EOF  is  sensed  on  unit  20. 

KNUM — The   category   number   to   which   the  file   will   be 
be  positioned. 

NUM — The  number  of  descriptions  in  this  category. 

MAXL — The  maximum  length  (in  words)  for  a  description. 

NG — Number  of  items  referred  to  in  this  category. 

GROUP — List  of  item  pointers  associated  with  this  category. 


Subroutines  called:  IFILE 

Common  data  referenced:   FNAMES,  WHICH  in/FILNAM/ 

Called  by:  NAME,  DUMPIT 

Error  checking  and  reporting:  None 

Program  logic: 

1.  The   next   record   on   unit   20    is   read,   giving   a   category 
number  KK  and  values  for  the  last  four  arguments. 

2.  KK  is  tested  against  KNUM. 

(a)  If  KK<KNUM,  record  pairs  are  skipped  up  to  the 

one  of  interest. 

(b)  If  KK  =  KNUM,  return. 

(c)  If  KK>KNUM,  rewind  unit  20  and  reassociate  it  with 

the  correct  name  via  a  call  to  IFILE  having 
FNAMES  and  WHICH  as  arguments.  Next,  reposi- 
tion the  file  to  the  number  pair  of  interest. 


GRASP 


SOURCE 


PROGRAM 


30 

40 
50 


60 


70 


80 
90 


SUBROUTINE    FINDGPl *, KNUM, NUM , MAXL t NG , GROUP ) 

COMMON    /FILNAM/    FN AM ES , WH  ICH , PAD 

INTEGER    GROUP (1 ) , FNAMES ( 2  1  ) , WHICH, PAD( 4 ) 

DATA    NDEF/20/ 

READ    (NDEF, END=90)     KK , NUM, MAXL ,NG , <GROUP( I ) , 1=1 , NG ) 

IF     (KK-KNUM)    40,80,70 

J=KNUM-KK-1 

READ(NDEF) 

IF    (J.LT.l)     GO    TO    30 

DO    60    1=1, J 

READ(NDEF) 

REAO(NDEF) 

GO    TO     30 

REWIND    NDEF 

CALL    IFILEiNDEF ,FN AMES ( 8+WH ICH) ) 

J=KNUM 

GO    TO    50 

RETURN 

RETURN     1 

END 
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SUBROUTINE  NAME:  FIT 

Purpose:  FIT  is  used  to  provide  a  least-square  linear  fit  be- 
tween two  items  within  a  selected  file. 

Calling  sequence:  CALL  FIT(J,ISWTCH) 

Arguments : 

J — Pointer  used  to  retrieve  argument  values  from  the  com- 
mon area  /FTNCOM/. 
ISWTCH — Switch  indicating  which  of  three  parts    (initial- 
ization, body,  postprocessing)  of  the  code  is  to  be  executed. 

Subroutines  called:  UNCODE 

Common  data  referenced: 
ITYPE  in  blank  common 
TAGS,  IREC,  ARGS,  NARGS,  in  /FTNCOM/ 

Called  by:  FDRIVE 

Error  checking  and  reporting:  If  two  arguments  are  not  given, 
an  appropriate  error  message  is  typed  and  return  is  immedi- 
ate. If  the  computation  would  yield  an  infinite  slope,  that 
message  is  typed. 

Program  logic:  The  value  of  ISWTCH  determines  which  of 
three  sections  of  the  code  is  executed.  If  ISWTCH=1„  the 
number  of  arguments  is  checked,  and  various  sums  are  set 


to  zero.  If  ISWTCH  =  2,  the  error  flag  is  tested.  If  not  set, 
the  appropriate  values  of  the  arguments  are  tested  for  non- 
blank.  If  nonblank,  they  are  added  to  the  appropriate  sums. 
If  ISWTCH  =  3,  the  slope,  intercept,  and  correlation  coeffi- 
cient are  calculated  (if  possible),  using  the  sums  previously 
determined.  They  are  then  printed  out  using  the  appropriate 
item  names.  All  summations  and  least-square  determinations 
are  done  using  double-precision  arithmetic  to  minimize  the 
round-off  effects  introduced  by  performing  the  computation 
using  only  one  pass  on  the  data. 

Assuming  the  function  FIT  X,Y  had  been  issued,  the  calcu- 
lations are  performed  using  the  following  formula: 

D=N-ZX2-2X-£X 

B>=:(N-2XY—2X-2Y)/D 

Bo=(2Y-B1-2X)/N  

C=DBi/VD(N--2Y2-2Y--2Y) 
where : 

B0= intercept, 

Z?i=slope, 

C— correlation  coefficient,  and 

iV=number  of  nonblank  X,  Y  points. 
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SOURCE 


PROGRAM 


•/ 

2,4,6 
E.2 
TO  20 


SUBROUTINE    F IT( J , I SWTC H ) 
COMMON    NAMES, ITYPE, IPTS, IPAD 

COMMON    /FTNCOM/    TAGS  ,  I REC  ,ARGS, NARGS, I FTN,NFTN 
DOUBLE    PRECISION    NAMES ( 500 ) , T AGS( 5 , 5 ) , SUMX, SUMY , SUMXY , 
1     SUMXS,SUMYS,D,FN,V1 ,V2 
INTEGER     IPTS(50C) 

INTEGER    ARGS (6, 5), NARGS (5  >,  IFTNC5) , ITYPE ( 5001, I REC (500) 
LOGICAL    ERR 

EQUIVALENCE     ( IV AL 1 , VAL 1 ) ,     (IVAL2,VAL2) 
DATA    IBLNK/« 
IF<  ISWTCH-2) 
ERR=NARGS(J). 
IF     (ERR)    GO 
N  =  0 

SUMX=0.0D0 
SUMY=0.0D0 
SUMXY=0.0D0 
SUMXS=0.000 
SUMYS=0.0D0 
GO    TO    30 

IF     (ERR)    GO    TO    30 
IVAL1=IREC(ARGS(2, J) ) 
IF    ( IVALl.EQ.IBLNK )    GO    TO    30 
I VAL2=IREC( ARGS(3,J) ) 
IF    ( IVAL2.E0.IBLNK )    GO    TO    30 
V1=IVAL1 
V2=IVAL2 

IF    ( ITYPE(ARGS( 2,J)).EQ.2) 
IF    ( ITYPE(ARGS(3, J ) ) .E0.2) 
IF(ITYPE(ARGS(2, J) J.EQ.5) 
IF(  ITYPE(ARGS(3, J)  ).E0.5) 
N=N+1 
SUMX=SUMX+V1 


V1=VAL1 

V2=VAL2 
V1=UNC0DE(VAL1 ,10) 
V2= UNCODE ( VAL2,IQ) 
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SUMXS=SUMXS+V1*V1 

0000757 

SUMXY=SUMXY+V1*V2 

0000758 

SUMY=SUMY+V2 

0000759 

SUMYS=SUMYS+V2*V2 

0000760 

GO    TO    30 

0000761 

6 

IF    (ERR)    GO    TO    30 

FN=N 

D=FN*SUMXS-SUMX*SUMX 

IF    (D.EQ.O.CDO)    GO    TO    10 

B1=(FN*SUMXY-SUMX*SUMY  )/D 

B0=( SUMY-B1*SUMX) /FN 

0000762 
0000763 
0000764 
0000765 
0000766 
0000767 

CC=(FN*SUMXY-SUMX*SUMY ) /DSQRTC ( FN* SUMXS-SUMX* SUMX) *( FN* SUMYS 

-SUMY 

*0000768 

1SUMY) ) 

0000769 

TYPE    40,    N, TAGS( I, J> ,TAGS(2,J) ,B1, BO 

,CC 

0000770 

GO    TO    30 

0000771 

10 

TYPE    5C,    N 

GO    TO     30 

0000772 
0000773 

20 

TYPE    60 

0000774 

30 

RETURN 

0000775 

40 

FORMAT     (/1X,I5,'    POINTS    USED 

TO    FIT 

■  ,A8,»T0 

•  ,A8/« 

SLOPE=' , 

1PE12 

.0000776 

15, •     INTERCEPTS ,512.5, •     CORR. 

COEFF.= 

=  ',E12.5) 

• 

0000777 

50 

FORMAT    (•     UNABLE    TO    CALCULATE 

FIT    WITH' ,I5,« 

POINTS' 

1  ) 

0000778 

60 

FORMAT     (•    THE    FIT    FUNCTION    MUST    HAVE 

2    ARGUMENTS' ) 

0000779 

END 

0000780 
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SUBROUTINE  NAME:  FTNC 

Purpose:  This  routine  acts  as  a  driver  for  the  processing  of 
the  FUNCTION  command.  It  accepts  (via  KEYBRD)  the 
function  names  and  arguments,  sets  up  system-required 
input-file  information,  and  is  then  used  to  supply  input 
records  to  the  routines  that  actually  calculate  the  requested 
functions. 

Calling  sequence:  CALL  FTNC(&n) 

Argument : 

n — Statement  (in  caller)   to  which  a  branch  is  made  if  the 
nonstandard  return   (EOF)  from  KEYBRD  is  taken. 

Subroutines  called:  KEYBRD,  OBEY,  DECOMP,  FDRIVE, 
GETPUT,  PACK 

Common  data  referenced: 

FNAMES,  WHICH  in  /FILNAM/ 

TAGS,  IREC,  ARCS,  NARGS,  IFTN,  NFTN  in  /FTNCOM/ 

NFILE  in  /IOUNIT/ 

Called  by:  DRIVER 

Error   checking   and   reporting:    Function   names   entered   by 


the  user  are  checked  against  a  list  of  those  available.  If  an 
invalid  function  name  is  entered,  that  message  is  typed. 
Program  logic: 

1.  A  prompted  input-file  name  is  obtained  via  KEYBRD, 
packed  via  a  call  to  PACK,  and  associated  with  the  FOR- 
TRAN input  unit  number  via  OBEY. 

2.  A  list  of  the  implemented  function  names  is  typed  along 
with  a  request  to  enter  the  names  of  desired  functions  and 
their  corresponding  arguments. 

3.  As  each  function  name  is  entered  (via  KEYBRD),  it  and 
its  argument  names  are  identified  via  DECOMP. 

4.  After  the  names  have  been  entered  and  identified,  a  call  to 
FDRIVE  using  an  argument  of  1  is  issued  to  perform 
initialization. 

5.  Each  record  of  the  selected  file  is  obtained  via  GETPUT 
and  processed  via  a  call  to  FDRIVE  using  an  argument  of  2. 

6.  Finally,  a  call  to  FDRIVE  using  an  argument  of  3  is  made 
to  accomplish  any  wrap-up  processing  associated  with  the 
selected  function,  and  the  input  file  is  rewound. 


GRASP 


SOURCE 


PROGRAM 


10 
20 


30 


SUBROUTINE 
COMMON  /FIL 
COMMON  /FTN 
COMMON  /IOU 
DOUBLE  PREC 
INTEGER  OFA 
1EQUATE(4) ,F 
2  PR0MPT(5) 
LOGICAL  ANY 
DATA  DBLNK, 
DATA  IMPLTD 
DATA  PROMPT 
EQUIVALENCE 
TYPE  100 
DFAULT=FNAM 
CALL  KEYBRD 
CALL  PACKU 
IF  (F  ILE.EQ 
CALL  OBEY(£ 
TYPE  120,  ( 
TYPE  130 
NFTN=1 
TYPE  150,  P 
CALL  KEYBRD 
CALL  DECOMP 
NARGS (NFTN) 
NFTN=NFTN+1 
IF  (NFTN-IM 
NFTN=NFTN-1 
IF  (NFTN.EQ 
ANY=. FALSE. 
DO  60  1=  lPN 
GOOD^.TRUE. 
INAME=ARGS( 
DO  40  J=  1,  I 
IF     (INAME.E 


FTNCI*) 

NAM/    FNAMES, WHICH, PAD 

COM/    TAGS, IREC,ARGS,NARGS, I FTN, NFTN 

NIT/    NFILE, IPAD 

ISI0N    TAGS(5,5) 

ULT,  FILE,DBLNK,FNAN*ES(21),WHICH,PAD(4),IFTN(  5)  , 

TNS( 5) ,ARGS(6,5)  ,1  MAGE ( 80 ), NARGS (5), IREC (500  I, 


,GOOD 

EQUATE/'  »,,EQUA»,«TE  1«,«1», 
,FTNS/2, 'MEAN* , •FIT«,3*1  •/ 
/•  i.«  ,,2.'  ,' 
(EQUATE(  <♦)  ,FILE  ) 


•/ 


ES( WHICH) 
(£90, IMAGE, 5) 
MAGE, FILE, 5,5) 
.DBLNK)  FIL£=DFAULT 
85, EQUATE, A) 
FTNS( I )  ,  1  =  1 ;  IMPLTD) 


ROMPTCNFTNI 

(&90,IMAGt  80) 

(£20 ,£30, 1MAGE,TAGS(1*NFTN),ARGS( 1 , NFTN ) ,NARG I 

=NARG-1 

PLTD-1)  20,30,30 

.0)  RETURN 

FTN 

1,1) 

MPLTD 

Q.FTNSI J) )  GO  TO  50 
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85 


40 


50 
60 


70 


80 


90 
LOO 
120 
13G 
150 
160 


CONTINUE 
TYPE  160,  INAME 
J  =  6 

G00D=. FALSE. 
IFTN( I)=J 
ANY=ANY.OR.GOOD 
IF    (  .NOT. ANY)    GO    TO    10 
CALL    FDRIVE(l) 
CALL    GETPUT<&80,IREC ,1) 
CALL     FDRIVE<2> 
GO    TO    70 
CALL    FDRIVEO) 
REWIND    NFILE 
RETURN 


RETURN 
FORMAT 
FORMAT 
FORMAT 
FORMAT 
FORMAT 
1ED.  ») 
END 


1 

(  • 
(• 
(  • 


ENTER  NAME  OF  F  ILE  :  •, $) 

FUNCTIONS  AVAILABLE  AT  THIS  TIME  ARE: • / IX, 5A8 » 

ENTER  FUNCTION  NAMES  AND  CORRESPONDING  ARGUMENTS.  ' 

(1X,A3,$) 

(IX, A5,'  IS  NOT  AN  AVAILABLE  FUNCTION  AND  HAS  S'BEEN 


0000817 
0000818 
0000819 
0000820 
0000821 
0000822 
0000823 
0000824 
0000825 
0000826 
00C0827 
0000828 
0000829 
0000830 
0000831 
0000832 
0000833 

I  0000834 
0000835 

IGN0R0000836 
0000837 
0000838 


GRASP  SOFTWARE  SPECIFICATIONS 


45 


SUBROUTINE  NAME:  GETPUT 

Purpose:  GETPUT  is  used  to  read  and  unpack  a  record  from 
the  current  input  file,  or  to  write  the  last-packed  record 
obtained  from  the  current  input  file  on  the  current  output 
file. 

Calling    sequence:    CALL    GETPUT (&n,IREC,ISWTCH) 

Arguments: 

n — Statement   (in  caller)    to  which  a  branch  is  made  if  an 

EOF  is  sensed  on  the  current  input  file. 
IREC — Contains  the  expanded  record  from  the  current  input 

file. 
ISWTCH — Switch  indicating  whether  record  is  to  be  read 
or  written. 

Subroutines  called:  None 

Common  data  referenced:  IN,  IOUT  in  /IOUNIT/ 

Called  by:  COLPNT,  DUMPIT,  FTNC,  RETRVE,  ROWPNT 

Error  checking  and  reporting:  None 

Program  logic: 

1.    If  ISWTCH  =  1,  the  next  input  record  is  read  into  TANK 


on  the  unit  referenced  by  IN  in  /IOUNIT/.  If  an  EOF  is 
sensed,  the  nonstandard  return  is  taken.  If  ISWTCH>1, 
the  last-read  input  record  is  output  on  the  unit  referenced 
by  IOUT  in  /IOUNIT/. 
2.  The  first  word  of  TANK  is  assumed  to  be  of  type 
INTEGER  and  corresponds  to  the  first  word  of  IREC.  The 
last  2  bits  contain  the  type  of  the  next  word  in  TANK. 
TYPE  values  are: 


TYPE 
1 
2 


Indicates 
Next  word  is  an  integer  value. 
Next  word  is  a  real  value. 
Next  word  is  a  blank  counter. 


The  value  part  of  types  1  and  3  is  in  the  leading  bits  (that 
is,  2-bit  truncation). 
3.  If  the  word  is  of  type  REAL,  it  may  be  visualized  as  being 
composed  of  an  integer  and  a  fraction.  The  type  for  the 
next  word  is  in  the  last  2  bits  of  the  integer  part  and  the 
associated  real  value  is  obtained  by  adding  the  fractional 
part  to  the  leading  bits  of  the  integer  part. 
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SOURCE 


PROGRAM 


10 


20 


25 


30 


40 
50 

6C 
70 

110 


SUB ROUT  IN E  GETPUT {*, IREC, ISWTCH) 

COMMON  /IOUNIT/  IN, IOUT 

INTEGER  IREC(  1  ) ,  I  TANM  150 ) , BLANK , TYPE 

REAL  TANKU50) 

EQUIVALENCE  ( FRACT , I VA L ) ,  ( I TANM 1 ) ,TANK ( 1 ) ) 

DATA  BLANK/'  '/ 

IFUSWTCH-2)  5,70,70 

READ  (IN,END=110)  NUM  ?  <  TANM  I  I  ,  I  =1  ,NUM  ) 

TYPE=1 

IPT=1 

DO  50  1=1, NUM 

IF(TYPE.LT.C)  TYPE=-TYPE 

IF  (TYPE- 2)  10,20,3  0 

IVAL=  ITANK(  I  )/4 

TYPE=ITANK( I )-4*lVAL 

GO  TO  2  5 

TYPE=TANK( I ) 

FRACT=TANK( I )-TYPE 

J=TYPE/4 

TYPE=TYPE-4*J 

FRACT=J+FRACT 

IREC( IPT)=I VAL 

IPT=IPT+1 

GO  TO  50 

J=ITANK ( I )/4 

TYPE=  ITANM  I)-4*J 

DO  40  K=1,J 

IREC(  IPT  )=8LANK 

IPT=IPT+1 

CONTINUE 

RETURN 

WRITE ( IOUT) NUM, (TANK (I ) ,1=1, NUM) 

GO  TO  60 

RETURN  1 

END 


0000839 
0CC0840 
0000841 
0000842 
0000843 
0000844 
0000845 
0000846 
0000847 
0000848 
0000849 
00C0850 
0000851 
00C0852 
0000853 
0000854 
0000855 
00C0856 
00C0857 
0000858 
0000859 
00C086C 
0000861 
0000862 
0000863 
000086*, 
0000865 
0000866 
0000867 
0000868 
0300869 
0000870 
0000871 
0C00872 
0000873 


46 


GEOLOGIC  RETRIEVAL  AND  SYNPOSIS  PROGRAM   (GRASP) 


SUBROUTINE  NAME:  HELP 

Purpose:  HELP  types  the  names  and  descriptions  of  GRASP 

commands  available  to  the  user. 
Calling  sequence:  CALL  HELP  (WORDS) 
Argument : 

WORDS — An   array   containing   the   command   names   that 
may  be  issued  by  the  user. 


Subroutines  called:  None 

Common  data  referenced:  None 

Called  by:  DRIVER 

Error  checking  and  reporting :  None 

Program  logic:  The  text  associated  with  each  of  the  commands 
is  initialized  in  DATA  statements.  Each  command  name  (in 
WORDS)  is  typed  with  its  corresponding  description  in 
TEXT. 


GRASP 


SOURCE 


PROGRAM 


SUBRO 
INTEG 
DOUBL 

1  MSG4 

2  MSG1 
EQUIV 

1  (MSG 

2  (MSG 

3  (MSG 
DATA 

l» ITER 

DATA 
1' PRES 

DATA 
P  PON 

DATA 
l'S     (V 

DATA 
1     'E    D 

DATA 
PESPO 

DATA 
P  AND 

DATA 
i •  IT  ID 

DATA 
l'S    WE 

DATA 
l'RD    I 

DATA 
PONS 

TYPE 

RETUR 

10    FORMA 

1ARE    L 

END 


UTINE    HELP(WORDS) 
ER    W0RDS(1 ) 
E    PREC ISION    TEXT( 
(11)  ,MSG5(  11), MSG 
0( 11) ,MSG11<11) 
ALENCE     (MSGl(l)fT 
3(1 ),TEXT( 1,3  )  >,< 
6( 1)  ,TEXT(1,6)  )  ,( 
9(  1),TEXT(  1,9)  ),( 
MSGl/«-     INITI A' ,' 
IA    T',  '0    BE    ENT' 
MSG2/'-     INITIA', 
SION' ,•     TO    BE     E« 
MSG3/'-    IN  IT! A  •  , 
PREV,  •  IOUSLY    E' 
MSG4/»-    ALLOWS'  , 
ARIA',  'BLE    NAME' 
MSG5/'-    ALLOWS'  , 
ATA    B'  ,'ASE    TO    B 
MSG6/'-    TERMIN', 
NSE' ,' TO    A    PRO' , 
MSG7/'-    USED    T' , 
DEFI', 'NIT  IONS' , 
MSG8/'-    USED    T'  , 
N  S  .  '  ,  5  *  '  '  / 

MSG9/'-  LISTS'  ,'T 
LL  A',  «S  THE  CO'  , 
MSGIO/'-  PRINTS', 
N  A'  ,' SELECTED'  ,' 
MSGU/'-  PROVID'  , 
ON  I','TEMS  IN', 
10,  (WORDS( J) ,(TE 
N 

T     COTHE    COMMANDS 
ISTED    BELOW:' /( • 


11,11)  ,MSG1(  11) ,MSG2( 11 ) ,MSG3(ll )  , 
6( 11),MSG7( ll),MSG8( 11) ,MSG9(  11)  , 


EXT(1,1) ) 
MSG4(  1  ),T 
MSG7(1),T 
MSG10(  1), 
TES  THE', 
•ERED  IN' 
TES  THE', 
• NTERED' , 
TES  THE', 
•NTERED', 

THE  USE' 
•S  WILL' , 

THE  USE' 
,'E  USED. 
ATES  THE' 
MPT  WILL' 
0  PRINT', 
IN  A  • ,' 
0  OBTAI N' 


,(MSG2( 1), 
EXT(  1,4) ), 
EXT(1,7)  )  , 
TEXT(  I,  10) 
•REQUEST' , 
,'THE  FORM 
•REQUEST' , 
•US  ING  LO' 
•SEARCH  0' 
•CONDITIO' 
,'R  TO  LIS 
•BE  ASKED' 
,'R  TO  SEL 
•  ,3*' 

,'  SYSTEM. 
,' ALSO  STO 
•ITEM  NAM' 
SELECTED', 
,'  THE  ABO 


TEXTU, 
(MSG5( 1 

(MSG8(1 
)  ,(MSG1 
•FOR  RE 
•  ,  •  :  NA 
•FOR  A 
, 'GICAL 
,'F  A  F 
,'NS  AN 
','T  SE 
,'  FOR) 
', 'ECT 
'/ 

,  •  ENT 
,  «P  TH 
•ES,  T 
SET  0 
,'VE  C 


2)), 
),TE 
),TE 
1(  1) 

TR', 
ME  R 
LO', 

OP' 
ILE' 
D  L' 
LECT 

IN' 
OR  C 


XT( 1,5) ), 
XT(1,8)  ), 
,  TEXTU  ,11)  ) 
•IEVAL    CR', 
• ,' EL    VALUE'/ 
•GICAL    EX', 
, 'ERATORS.'/ 
, •     BASED    U' , 
,'OGIC.     »/ 
', 'ED   VALUE', 
,'     A    FILE.'/ 


ERIN' ,'G  IN    R« , 

E    SY', 'STEM.     •/ 
HEP  ,'R    TYPES', 
F'  ,  'GROUPS. '/ 
OMMA' , 'ND    DEFIN', 


HE 

•NDITIONS' 
•  ALL 


WHICH' , 'HAVE 
•AND  LOGP  ,'C 
PRESE' , 


FILE.' ,' WAITS 
•ES  FOR  P ,'HE  CCMPU' 
•A  DATA', »SET  (OR',  'FILE) 
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FUNCTION  NAME:  ICONV 

Purpose:  ICONV  is  used  to  convert  a  number  from  unpacked- 

character  form  to  numeric  fixed-point  form. 
Calling       sequence:       IVAL  =  ICONV  (TANK,LNGTH, EXP, 

ERR) 
Arguments: 

TANK — Contains  the  number  to  be  converted  in  unpacked- 

character  form. 
LNGTH — The  number  of  elements  in  TANK. 
EXP — The  power  of  10  to  which  the  value  returned  must 

be  raised  to  obtain  the  floating  point  value  represented. 
ERR — An  error  flag  which  is  turned  on  if  an  error  is  de- 
tected. 
Subroutines  called:  None 


Common  data  referenced :  None 

Called  by:  OPREP,  PARSE,  RELEXP 

Error  checking  and  reporting:  Each  character  is  checked.  If 
an  invalid  character  is  detected,  an  error  message  is  typed, 
and  the  error  flag  is  turned  on. 

Program  logic:  If  all  characters  are  blank,  blank  is  returned 
as  a  value.  Leading  blanks  and  imbedded  commas  are 
ignored,  and  a  blank  acts  as  a  string  deliminator.  If  a 
decimal  point  is  sensed,  the  position  counter  EXP  is  initial- 
ized to  1  and  incremented  for  each  subsequent  digit.  As 
each  digit  is  detected  in  a  left-to-right  fashion,  the  value  is 
shifted  left  one  digit,  and  the  detected  digit  is  added  to  the 
least  significant  part  of  the  value.  If  all  (LNGTH)  char- 
acters have  been  scanned  or  if  a  trailing  blank  is  detected, 
the  scan  is  terminated  and  control  is  returned  to  the  caller. 


GRASP 


SOURCE 


PROGRAM 


10 


20 


30 


4C 


50 


60 
70 
80 

90 
100 


INTEGER    F UNCTION ICONV (TANK, LNGTH, EXP, ERR) 

INTEGER    TANK(     1 ), D IG ITS ( 1 0) , BLANK, COMMA , POI NT ,E XP ,V ALUE 
LOGICAL    ERR 

DATA    RLANK, COMMA, P0INT/4H  ,4H,  ,4H.  /,DIGITS/4H0 

14H2  ,4H3  ,4H4  , 4H 5  ,4H6  ,  4H  7  ,4H8  ,4H9  / 

ERR=. FALSE. 
EXP  =  0 

IF     (LNGTH. GT.0)    GO    TO     10 
ICONV=BLANK 
GO    TO    90 
VALUE=0 

DO    20    K=l , LNGTH 

IF    ( TANK(K) ,NE. BLANK)     GO    TO    30 
C0NT INUE 
30    TO    80 
DO    70    J=K, LNGTH 
NEXT=TANK(J  ) 
IF     (NEXT. E0. COMMA) 
IF     (NEXT. EQ  .BLANK) 
IF    (NEXT. NE .POINT) 
EXP=1 
GO    TO     70 

IF     (EXP.GT.O)    EXP=EXP+1 
DO    50    L=l,10 

IF     (MEXT.E3  .DIGITStL  )  )    GO    TO    60 
CONTINUE 

TYPE     100,    VALUE  ,  EXP,  (  TANML  )  ,L  =  1,  LNGTH) 
ERR=.TRUE. 
GO    TO    90 

VALUE=10*VALUE+L-1 
CONT INUE 

EXP=MIN0(0,  1-EXP) 
ICONV=VALUE 
RETURN 

FORMAT     (15H     BAD    CHARACTER    ,  1 1 1  , 1  5 , 3X ,64A 1  I 
END 


4H1 


GO 

TO 

70 

GO 

TO 

80 

GO 

TO 

40 
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0000944 
30009^5 
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SUBROUTINE  NAME:  IFILE 

Purpose:  This  subroutine  is  used  to  associate  dynamically 
the  name  of  an  existing  data  set  with  a  FORTRAN 
input  unit  number  (that  is,  logical  device  number).  When 
this  subroutine  is  called,  the  file  is  opened  and  read;  state- 
ments referencing  the  unit  number  given  in  the  argument 
list  are  directed  to  the  named  file.  The  file  may  be  closed 
by  use  of  a  rewind  statement. 

Calling  sequence:  CALL  IFILE (LNAME) 

Arguments: 

I — An  integer  variable  or  constant  specifying  a  logical  de- 
vice number. 


NAME — Either  a  literal   (hollerith)   constant  or  a  variable 
containing  a  file  name  consisting  of  five  or  fewer  char- 
acters. 
Subroutines  called:  None 
Common  data  referenced :  None 
Called  by:   BINTYP,   DEFLST,   FINDGP,   OBEY,   START, 

FILES 
Error  checking  and  reporting :  None 

Program  logic:  This  is  a  DEC  1070,  TOPS-10  system  resi- 
dent routine.  It  provides  the  capabilities  referred  to  in  the 
Purpose  section  above.  If  the  GRASP  system  is  to  be  im- 
plemented on  some  other  main  frame,  a  comparable  routine 
must  be  written  or  acquired.  No  listing  is  shown  here. 


GRASP  SOFTWARE  SPECIFICATIONS 


49 


SUBROUTINE  NAME:  INIT 

Purpose:  INIT  initializes  a  set  of  words  and  codes  for  future 
table  lookup.  The  initialization  assumes  that  the  "linear 
quotient  hash  code"  technique  will  be  used  for  table  lookup. 
See  Bell  and  Kaman  (1970)  for  a  complete  description  of 
the  technique. 
Calling  sequence:  CALL  INIT(CHARS,CODES,M,SYMBOL, 

N) 
Arguments: 

CHARS — Table  which  is  to  contain  the  symbols  in  "hash- 
coded"  order. 
CODES — Table  giving  the  index  of  the  symbol  as  it  was 

stored  in  CHARS. 
M— Table  size   for   CHARS    and   CODES.    Note  this   must 
be  a  prime  number. 


SYMBOL— Table  of  words  to  "hash"  into  CHARS. 

N— Number  of  words  in  SYMBOL. 
Subroutines  called :  None 
Common  data  referenced :  None 
Called  by:  LOGEXP,  PARSE 
Error  checking  and  reporting :  None 
Program  logic: 

1.  CHARS  is  filled  with  "VOID,"  the  flag  for  an  empty  loca- 
tion. 

2.  Each  element  of  SYMBOL  is  then  inserted  into  CHARS 
at  the  "hashed"  address.  "Collisions"  are  handled  via  the 
linear-quotient  method. 

3.  As  each  element  of  SYMBOL  is  "hashed"  into  CHARS,  its 
position  is  stored  in  CODES. 

4.  The  initial  probe  address  and  collision  displacement  are  de- 
termined from  the  contents  of  each  element  of  SYMBOL. 


GRASP 


SOURCE 


PROGRAM 


10 


20 


30 
40 


SUBROUTINE     INIT(CHARS,CODES,M,SYMBGL,N) 

INTEGER    FILLER»CHARS( 1),C0DES(1) , SYMBOL ( 1) 

DATA    FILLER/'VOID' / 

DO     10    1=1, M 

CHARS(  I)  =  FILLER 

00    40     IC0DE=1 ,N 

ICHAR=SYMB0L( IC0DE ) 

L=IABS( ICHAR ) 

J  =  L/M 

I=L-M*J 

IF    (M0D( J,M ).EQ.0)     J=l 

IF  (CHARSd+l)  .E0.  FILLER)  GO  TO  30 

I=M0D( I+J,M) 

GO  T3  20 

CHARS(I+1)=ICHAR 

C0DES(  H-1)=IC0DE 

RETURN 

END 
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SUBROUTINE  NAME:  KEYBRD 

Purpose:  KEYBRD  accepts  all  user  input  in  unpacked  char- 
acter form  and  returns  it  to  the  caller. 
Calling  sequence:  CALL  KEYBRD  (&m,IMAGE,N) 
Arguments : 

m — Statement    number    (in    caller)    to   which    a    branch    is 

made  if  an  EOF  is  found. 
IMAGE — Contains    the    user    input    in    unpacked    character 
form. 


N — Number  of  characters  to  be  read. 
Subroutines  called:  None 
Co7timon  data  referenced :  None 
Called   by:   BDEF,   COLPNT,   CONDTN,   DEFLST,   FTNC, 

LIST,     LOGEXP,     OPREP,     QUIT,     RETRVE,     VLIST, 

FILES,  DRIVER,  OBEY,  PAUSE 
Error  checking  and  reporting:  None 
Program  logic:  KEYBRD  accepts  input  from  the  user  (unit  5) 

and  takes  nonstandard  return  if  EOF  occurs. 
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SOURCE 


PROGRAM 


10 
20 


SUBROUTINE  KEY BRD< *,  IMAGE, N ) 

DATA  IX/'  • / 

DIMENSION  IMAGE(l) 

READ( 5,20tEND=lC)  ( IMAGE( I ) ,I=1,N) 

IF(  IMAGE(  1)  .EQ. IX)  GO  TO  10 

RETURN 

RETURN  1 

FORMATt  80A1) 

END 
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SUBROUTINE  NAME:  LENGTH 

Purpose:   LENGTH   determines   the   number  of  leading   non- 
blank  words  in  a  character  string. 

Calling  sequence:  CALL  LENGTH  (VECT,N,L) 

Arguments: 

VECT — Array   containing   the    character    string   to   be   ex- 
amined. 


N — The  number  of  words  to  check. 

L — The  number  of  nonblank  leading  words. 
Subroutines  called:  None 
Common  data  referenced :  None 
Called  by:  DEFLST,  DUMPIT,  NAME 
Error  checking  and  reporting:  None 
Program  logic:  The  first  full-word  blank  is  searched  for;  its 

position  is  returned  in  L. 
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SOURCE 


PROGRAM 


1C 
20 


SUBROUTINE    LENGTH! V ECT, N, L ) 

INTEGER     VECT(l) 

DATA     IBLNK/*     •/ 

L=0 

DO    10    1=1, N 

IF(VECT<  I  I.EQ.IBLNKI  GO  TO  20 

L  =  L  +  1 

RETURN 
END 
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SUBROUTINE  NAME:  LIST 

Purpose:  LIST  is  used  as  a  driver  for  the  listing  of  items 
from  a  selected  file.  LIST  performs  initialization  common 
to  both  row  and  column  forms  of  printout,  and  rewinds  the 
input  file  after  returning  from  the  routine  which  created 
the  printout. 

Calling  sequence:  CALL  LIST(&n) 

Argument: 

n — Statement  (in  caller)  that  is  branched  to  if  an  EOF  is 
sensed  in  any  of  the  called  routines. 

Subroutines  called:  OPREP,  KEYBRD,  ROWPNT,  COLPNT 

Common  data  referenced :  None 


Called  by:  DRIVER 

Error  checking  and  reporting:  The  user  response  returned  by 

KEYBRD  is  checked  for  validity.  If  in  error,  a  message  is 

typed,  and  the  user  is  prompted  again. 
Program  logic: 

1.  The  input  file  name   and   page  size  are  set  by  a  call   to 
OPREP. 

2.  The  user  is  prompted  for  "C"    (column)    or  "R"    (row) 
to  establish  the  desired  output  form. 

3.  Either  ROWPNT  or  COLPNT  is  called  depending  on  the 
user's  response  to  step  2  above. 

4.  The  input  file  is  rewound  prior  to  the  return  to  DRIVER. 


GRASP 


SOURCE 


PROGRAM 


SUBROUTINE    LIST(*) 
COMMON    /IOUNIT/    NFILE,  IOFILE 
DATA     IC  ,IR/'C  ,«R' / 
CALL     OPREP( 650,£45,NPAGE) 
10    TYPE    6C 

CALL    KEYBRD(C50,IM,1) 
IF    (  IM.EQ.IC)    GO    TO    30 
IF     ( IM.EQ.IR)    GO    TO    20 
TYPE     70 
GO    TO    10 
20    TYPE     80 

CALL    R0WPNTU50,NPAGE) 
GO    TO    40 
30    TYPE    80 

CALL    COLPNT (£50, NPAGE) 
40    REWIND    NFILE 
45  RETURN 

50    REWIND    NFILE 
1 

(•    ENTER    C    FOR    COLUMN    OR    R    FOR    ROW    PRINTING:     •  ♦$) 
(•    YOUR    REPLY    WAS    NOT    UNDERSTOOD.') 
(•     AT    EACH    PAUSE    PRESS    CR    KEY    TO    CONTINUE.    '.'TO    ABORT 


RETURN 

60 

FORMAT 

70 

FORMAT 

80 

FORMAT 

1R    A.  •  ) 

END 
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SUBROUTINE  NAME:  LOGEXP 

Purpose:  This  routine  accepts  a  logical  expression  as  user  in- 
put via  a  call  to  KEYBRD  and  returns  the  encoded  Re- 
verse-Polish form  of  the  expressions.  The  logical  expression 
may  be  composed  of  single-letter  (A-Z)  operands  which 
refer  to  previously  entered  conditions,  the  logical  operators 
"and,"  "or,"  "not,"  and  the  grouping-  symbols  (,).  Each  of 
the  logical  operators  may  be  denoted  in  two  ways,  as  fol- 
lows: .AND.  or  *,  .OR.  or  +,  .NOT.  or  — . 
Calling  sequence:  CALL  LOGEXP (&n,POLISH,LPS,NCOND) 
Arguments : 

n — Statement  number  (in  calling  routine)  to  which  a  branch 

will  be  made  if  an  EOF  is  sensed  by  KEYBRD. 
POLISH — Contains  the  encoded   Reverse-Polish   form   of  a 
logical  expression.   Let  n  denote  the  value  of  some  ele- 
ment of  POLISH.   Then   1^  n=^26  implies  reference  to 
the  nth   condition   entered.   If  29^n=^31,  the   logical   op- 
perators  OR,  AND,  NOT  correspond  to  these  three  values. 
No  other  values  will  be  assumed  by  elements  of  POLISH. 
LPS — Gives  the  number  of  elements  in  POLISH. 
NCOND — Gives  the  number  of  conditions  which  have  been 
entered  by  a  previous  call  to  CONDTN. 
Subroutines  called:  INIT,  KEYBRD,  SCAN,  FIND,  PACK 
Common  data  referenced:  LOGIC  in  /INPUT/ 
Called  by:  DRIVER 

Error  checking  and  reporting:  The  logic  expression  entered  is 
checked  for  syntactic  correctness.  Following  are  eight  error 
messages  which  may  be  typed : 

1.  LOGICAL  OPERATOR  NOT  PRECEDED  BY  A  )  OR 
A  LETTER  (A-Z). 

2.  UNBALANCED  PARENTHESIS. 

3.  LETTER  (A-Z)  NOT  SEPARATED  BY  AN  OPERA- 
TOR. 

4.  UNEXPECTED  LEFT  PARENTHESIS  OR  .NOT.  OP- 
ERATOR (  — ). 

5.  INVALID  CHARACTER  IN  EXPRESSION. 

6.  UNDETERMINED  SYNTAX  ERROR.  CONTACT  PRO- 
GRAMMER. 

7.  LOGIC  EXPRESSION  REFERENCES  A  CONDITION 
(A-Z)   WHICH  WAS  NOT  ENTERED. 


8.    OPERATOR   NOT   ENCLOSED  WITH  PERIODS.  RE- 
ENTER LOGIC. 
Program  logic: 

1.  On  the  first  call  to  LOGEXP,  a  call  to  INIT  is  made  to 
"hash-code"  the  elements  of  SYMBOL  into  CHARS.  CODES 
is  used  to  save  the  original  indices. 

2.  A  prompt  message  is  typed  and  a  call  to  KEYBRD  is 
made  to  get  the  input  string  which  is  then  packed  into 
LOGIC. 

3.  After  initialization  of  pointers  and  counters,  a  call  is  made 
to  SCAN  to  bracket  the  nonblank  section  of  STRING. 

4.  At  this  point  the  actual  algorithm  begins.  Transition  mat- 
rix parsing  is  used  with  the  following  transition  matrix 
(IMAT)  : 


A-Z 

f(l)/2 
f(7)/3 


+  * 

f(7)/l 
f(3)/l 


(— 

f(4)/l 
f(7)/4 


f(7)/2 
f(5)/2 


blank 
f(2)/l 
f(2)/2 


f(6)/l 
f(6)/l 


where  f(i)/j  means  "do  the  i'th  job  and  set  the  next  row 
value  to  j."  The  jobs  are: 

f(l) — Insert  character  code  into  Reverse- Polish  string  and 
test  to  determine  if  there  has  been  a  condition  entered 
for  it. 
f  ( 2 )  — Go  scan  next  character. 

f(3) — Pop  stack  into  POLISH  until  value  of  topmost  ele- 
ment is  less  than  character  code.  Then  do  f(4). 
f  ( 4 )  — Push  down  character  code  into  stack. 
f(5)—  Pop   stack    into    POLISH    until   the    value   for    (    is 

reached.  Remove  value  for  (. 
f(6) — Period  character  sensed,   find   next  matching  period 

and  determine  logical  operator, 
f  (7) — Type  the  error  message  pointed  to  by  the  row  value, 

then  request  reentry  of  logic. 
Each  character  of  STRING  is  scanned  using  the  subroutine 
FIND  to  obtain  its  code  ICODE.  ICODE  is  an  index  to 
ICOLS  which  then  determines  the  proper  column  of  IMAT. 
This  element  IFTN  is  then  broken  down  into  a  function 
pointer  JOB  and  a  next  row  value  STATE.  Control  is  then 
passed  to  the  function  indicated  by  JOB.  After  the  func- 
tion has  been  completed,  the  next  character  of  STRING  is 
scanned  if  an  error  was  not  detected.  If  an  error  was  de- 
tected, the  appropriate  message  is  typed. 


GRASP 

SUBROUT INE    LOGEXP( 

COMMON    /INPUT/    EXP 

DOUBLE    PREC ISIQN    E 

INTEGER     POLISH(i), 

15) ,IMAT(2,6) tCODES 

LOGICAL    CALLED 

DATA    SYMBOL/' A*  ,  •  B 

1' ,'0'  , 'P'  ,'Q'  ,'R'  , 

2t-.,i     itt../ 

DATA     IC0LS/26*1,3, 

DATA     IMAT/12,73,71 

DATA    ERRMSG/'LOGIC 

l'A    LETTER', •     (A-Z) 

2'LETTER     (','A-Z)    N 

3'                   ','UNEXPECT 

4'RATOR     (-','). 

SOURCE 


PROGRAM 


*, POLISH, LPS, NCOND) 

R, LOGIC 

RRMSG(7,6) ,EXPR( 4,26), LOGIC (8) 

I  COLS (33) , CHARS (41), TOP, FC, ST ATE, OR, AND, STACK ( 

(41) , SYMBOL (33), STRING (80 ), PER IOD, BLANK 

','C','D','E','F','G','H','I','J','K','L','M', 

,s^,T^'u^,v^,N^,)(^,Y^'z^l(^,)^,+^'* 


4,2,2,3,5,6/,    CALLED/. FALSE./ 
,31,41,74,72,52,21,22,61,61/ 

AL ', 'OPERATOR', •     NOT    PRE', 'CEDED    BY','     A 
. '  ,'UNBALANC , • ED    PAR  EN', 'THES  IS. ',4*' 
OT','     SEPARAT','ED    BY    AN','     OPERATO','R.  • 

•  ,  '  ED    LEFT', 'PARENTHE', 'SIS    OR    .','NOT.    OPE', 
','  INVALID'  ,'CHARACTE« ,'R    IN    EXP' , • RESS  ION  .  • , 


OR' 


0001006 
0001007 
0001008 

1  0001009 
0001010 
00C1011 

•N0001012 

',0001013 
0001014 
0001015 
0001016 

,  0001017 
0001018 
0001019 
0001020 
0001021 
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53*'  ',  'UNDETERM1, MNED    SYN«,»TAX    ERRO'^R.    CONTA'.'CT    PROGR*  ,0001022 

6»AMMER.,,»  •/ ,OR,AND,NCT/,OR', 'AND',  'NOTV  0001023 

EQUIVALENCE     ( SYMBOL ( 32 )  , BLANK ),( SY MBOL (33 ), PERI  00)  0001024 

IF    (CALLED)    GO    TO    20  0001025 

CALLED=.TRUE.  0001026 

CALL     INIKCHARS,  CODES,  41,  SYMBOL, 33)  0001027 

20    TYPE    250  0001028 

CALL    KEYBRDU245,  STRING,  80)  0001029 

CALL    PACMSTRING, LOGIC,  80,80)  0001030 

TOP=l  0001031 

STACK(1)=0  0001032 

LPS=0  0001033 

STATE=1  0001034 

CALL    SCANU30, STRING,  1  ,  IPT,LNGTH, 2)  0001035 

IPT=IPT-1  0001036 

GO    TO   40  0001037 

3C  RETURN  0001038 

40    NSTATE=STATE  0001039 

IPT=IPT+1  0001040 

IF    (  IPT.GT.LNGTH)    GO    TO    230  0001041 

CALL     FIND(G50,STRING(IPT), ICODE, CHARS, CODES, 41)  0001042 

GO    TO    60  0001043 

50    STATE=5  00C1044 

GO    TO    220  0001045 

60    IFTN=IMAT(NSTATE, ICOLSC ICODE) )  0001046 

JOB=IFTN/10  0001047 

STATE=IFTN-10*JOB  0001048 

GO    TO     ( 70,40,90,100,110,130,220)  , JOB  0001049 

70    LPS=LPS+1  0001050 

POLISH(LPS)=ICODE  0001051 

IF    ( ICODE. LE.NCOND)    GO    TO    40  0001052 

TYPE    270  0001053 

GO    TO    20  0001054 

90    IF    ( STACK(TOP).LT. ICODE)    GO    TO    100  0001055 

LPS=LPS+1  0001056 

POLISH(LPS)=STACK(  TOP)  0001057 

T0P=T0P-1  0001058 

IF     (TOP.GT.O)    GO    TO    90  0001059 

STATE=6  0001060 

GO    TO    220  0001061 

100    TOP=TOP+l  0001062 

STACK( TOP)=ICODE  0001063 

GO    TO    40  0001064 

110     IF     (STACK(TOP).EQ.27)    GO    TO    120  0001065 

LPS=LPS+1  0001066 

POLISH(LPS)=STACK(TOP)  0001067 

TOP=TOP-l  0001068 

IF    (TOP.GT.O)    GO    TO    110  0001069 

STATE=2  0001070 

GO    TO    220  0001071 

120    T0P=T0P-1  0001072 

IF     (TOP.GT.O)    GO    TO    40  0001073 

STATE=2  0001074 

GO    TO    220  0001075 

130    FC=IPT+1  0001076 

DO    14C    I=FC,80  0001077 

IF     (STRING(  I  ).NE. BLANK)    GO    TO     160  0001078 

140    CONTINUE  0001079 

150    TYPE     280  0001080 

GO    TO    20  000  1081 
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160    FOI  0001082 

DO     17C    IPT=FC,80  0001083 

IF     (STRINGC IPTI.EQ. PERIOD)    GO    TO     180  0001084 

170    CONTINUE  0001085 

GO    TO     150  0001086 

180    NCHAR=3  0001087 

IC0DE=0  0001088 

190    NCHAR=NCHAR-1  0001089 

NCH=FC+NCHAR  0001090 

IOP=CHARS(21)  0001091 

CALL     PACKISTRING(FC), IOP ,NCH-FC+ I, 4)  0001092 

IF     UOP.EQ.AND>     ICODE=30  0001093 

IF    HOP. EO. NOT)     IC0DE  =  3l  0001094 

IF     (IOP.EO.OR)     IC0DE=29  0001395 

IF    (ICODE.NE.O)    GO    TO    200  0001096 

IF     (MCHAR.GT.l)    GO    TO    19C  0001097 

STATE=6  0001098 

GO    TO    220  0001099 

20C     IF    ( IC0DE.LT.31)    GO    TO    210  0001100 

IF    (NSTATE.EQ.l )    GO    TO     ICO  0001101 

STATE=4  0001102 

GO    TO    220  0001103 

210    IF     (NSTATE.EQ.2 )    GO    TO    90  0001104 

STATE=1  0001105 

220    TYPE    30C,     < ERRMSG( I , STATE ) , 1= 1, 7 )  0001106 

GO    TO    20  0001107 

230    IF    (TOP.EQ.l)    GO    TO    30  0001108 

IF     (STACK(TOP) .GT.28)    GO    TO    240  0001109 

STATt=2  0001110 

GO    TO    220  0001111 

240    LPS=LPS+1  0001112 

POLISH(LPS)=STACK< TOP)  0001113 

T0P=T0P-1  0001114 

GO   TO    230  0001115 

245    RETURN    1  0001116 

250    FORMAT    (•    ENTER    LOGIC:     •,$)  0001117 
27C    FORMAT    (•     LOGIC    EXPRESSION    REFERENCES    A    CONDITION    {A-Z)','     WHICH    W0001118 

IAS    NOT    ENTERED.1)  0001119 
280    FORMAT    (•    OPERATOR    NOT    ENCLOSED    WITH    PERIODS.    RE-ENTER    LOGIC.')          C00112C 

30C    FORMAT    (•     LOGICAL    ERROR: ' /1X , 7A8 )  0001121 

END  0001122 
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SUBROUTINE  NAME:  MEAN 

Purpose:  MEAN  provides  for  the  computation  of  range,  mean, 

sum,  root  mean  square,  and  sum  of  squares  for  as  many  as 

five  specified  items  in  a  specified  file. 
Calling  sequence:  CALL  MEAN(J.ISWTCH) 
A  rguments  : 

J — Pointer  used  to  retrieve  argument  values  from  the  com- 
mon area  /FTNCOM/. 

ISWTCH — Switch  indicating  which  of  three  parts  (initiali- 
zation, body,  postprocessing)  of  the  code  is  to  be  executed. 
Subroutine  called:  UNCODE 
Common  data  referenced: 

ITYPE  in  blank  common 

TAGS,  IREC,  ARGS,  NARGS  in  /FTNCOM/ 


Called  by:  FDRIVE 
Error  checking  and  reporting :  None 

Program  logic:   The  value  of  ISWTCH  determines  which  of 
three  sections  of  the  code  is  executed. 

If  ISWTCH  =  1,  sums  and  range  values  are  initialized.  If 
ISWTCH  — 2,  the  type  for  each  argument  value  is  deter- 
minted  and  its  value  is  added  to  the  appropriate  sums. 
Range  values  are  updated  if  required.  If  ISWTCH  =  3,  the 
final  computations  are  performed  and  the  results  typed  out 
to  the  user. 

The  mean  is  determined  using  X=XX/N  and  the  root  mean 
square  is  determined  using  RMS^'EX'/N,  where  N  is  the  num- 
ber of  nonblank  values  of  X. 
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SOURCE 


PROGRAM 


SUBROUTINE    MEAN ( J , I SWTCH ) 

COMMON    NAMES, ITYPE, IPTSt IOIM 

COMMON    /FTNCOM/    TAGS , I P EC , APGS , NARGS , I FTN , NET N 

DIMENSION    ARGS(6,5),    NARGSC5),     IFTNC5),     ITYPE(500),     IREC(500), 
1IPTS(500) ,NSUM(5),     SUMX(5),     SUMXSC5),    VMAX<5),     VMIN(5) 

DOUBLE    PRECISION    NA MES( 500 ) , TAGS (5 ,5 ) 

INTEGER    ARGS 

EQUIVALENCE     (IVAL.VAL) 

DATA     IBLNK/'     •/ 

IFdSWTCH-2)    5,15,25 
5    K=NARGS(J1 

DO     10    1=1, K 

SUMX( I )=0. 

VMAXU  )  =-1.  E30 

NSUM( I >=0 

VMIN( I )  =  1 .E30 
10    SUMXStI )=0. 

GO    TO     55 
15    K=NARGS(J) 

DO    20    1=1, K 

IVAL  = IREC(ARGS( 1+1, Jl) 

IF     ( I VAL.EQ. IBLNK)     GO    TO    20 

NSUM(  I  )=NSUM(  I )  +  l 

VALUF=IVAL 

IF  (I  TYPE!  ARGSU+1,  J)  J.EQ.5)     VALUE  =  UNCODE  (  VAL,  IQ) 

IF     (ITYPE(ARGS(  I  +  1,J  )) .E0.2 )     VALUE=VAL 

IF    (VALUE. LT.VMINI I ))    VM I N( I )=VALU E 

IF     ( VALUE. GT.VMAX( I ) )     VMAX ( I ) =VALU E 

SUMX(  I  )  =  SUMX(  H+VALUE 

SUMXSU  )=SUMXS(  IH- VALUE* VALUE 
20    CONTINUE 

GO    TO    55 
25    K=NARGS(J) 

DO    50    1=1, K 

IF    (NSUM(  I  )  .EQ.O)     GO    TO    30 

TYPE    60,     TAGSCI ,J) ,NSUM( I ) 

AMEAN=SUMX( I )/NSUM( I ) 

RMS=SUMXS(I )/NSUM( I ) 

IF    ( ITYPE(ARGS( 1+1 , J)» .EG. 2)    GO    TO    40 

IF  (ITYPE(ARGS( 1+1, J)) ,EQ.5>  GO  TO  40 


00C1123 
0001124 
0001125 
0001126 
0001127 
0001128 
00C1129 
0001130 
0001131 
0001132 
0001133 
0001134 
C001135 
0001136 
3301137 
0001138 
0001139 
000L140 
0001141 
0001142 
0001143 
0001144 
0001145 
0001146 
0001147 
0001148 
00C1149 
0001150 
0001151 
0001152 
0001153 
0001154 
0001155 
0001156 
0001157 
0001158 
0001159 
0001160 
0001161 
0001162 


GRASP  SOFTWARE  SPECIFICATIONS  57 

MIN=VMIN(I)  0001L63 

MAX=VMAX(I>  0001164 

TYPE  80,  MIN,MAX,AMEAN,RMS,SUMX<  I  >  ,SUMXS<  I )  0001165 

GO  TO  50  00C1166 

30  TYPE  70,  TAGS(ItJ)  0001167 

GO  TO  50  0001168 

40  TYPE  80,  VMIN( I ) ,VMAX(I )  , AMEAN, RMS , SUMX ( I ) , SUMX S<  I)  0001169 

50  CONTINUE  0001170 

55  RETURN  00C1171 

60  FORMAT  (/•  MEAN  STATISTICS  FOR  • , A8 , *W ITH« , 16, •  ITEM(S).»)  0001172 

70  FORMAT  (/•  NO  VALUES  PRESENT  FOR  «,A8)  0001173 

80  FORMAT  (•   MIN=«,  1PG9.2,  •  MAX*9 9G9.2,  •       MEAN=  •  ,  G9.  2,  •   ROOT  MEAN  00C1174 

1SQ.  =  »  ,G9.2/«   SUM  =  »  ,G12.5,«   SUM  OF  SQUARES=* , Gl 2 . 5 )  0001175 

END  0001176 
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SUBROUTINE  NAME:  NAME 

Purpose:  NAME  provides  the  user  with  the  mechanism  for 
examining  the  structure  and  content  of  the  current  data 
base.  The  user  is  permitted  to  select  categories  of  interest. 
Item  names,  types,  and  descriptions  for  all  entries  in  selected 
categories  are  printed.  The  user  is  also  permitted  to  see  the 
values  which  are  assumed  (in  the  current  data  base)  by 
character-  and  multiple-choice-type  items. 

Calling  sequence:  CALL  NAME  (&n) 

Argument: 

n — Statement  number  (in  caller)  to  which  a  branch  is  made 
if  the  second  nonstandard  return  is  taken  from  DEFLST 
(EOF  sensed  by  KEYBRD),  or  EOF  is  sensed  in  BDEF. 

Subroutines  called:  DEFLST,  PAUSE,  FINGDP,  LENGTH, 
BDEF 

Common  data  referenced :  None 


Called  by:  DRIVER 

Error  checking  and  reporting :  None 

Program  logic: 

1.  DEFLST  is  cajlled  to  select  those  categories  of  interest 
(LIST). 

2.  For  each  category  selected,  a  call  is  made  to  FINDGP 
to  obtain  the  names,  types,  and  descriptions  for  all  items 
within  that  category.  They  are  then  printed  under  the  cate- 
gory name. 

3.  Programmed  pauses  after  each  category  or  30  lines  of  out- 
put are  provided  via  calls  to  PAUSE. 

4.  A  call  to  LENGTH  is  made  to  determine  the  number  of 
nonblank  words  in  the  description. 

5.  Unit  20  (used  by  DEFLST  and  FINDGP)  is  rewound 
prior  to  returning  to  DRIVER. 
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SOURCE 


PROGRAM 


SUBROUT INE 
INTEGER    CAT 
DOUBLE    PREC 
CALL    DEFLST 
TYPE     70 
CALL     PAUSE( 
DO    30     K  =  1,N 
KNUM=LI ST(K 
CALL     FINDGP 
READ     (20)     ( 
CALL    LENGTH 
TYPE    90,     (C 
TYPE     91 
L  INE=0 
10    LINE=LINE*1 
IF     (LINE.GT 
IF    <M0D(LIN 
CALL    PAUSEt 
TYPE     90,     <C 
TYPE     100 
TYPE    91 
20  CALL    LENG 

TYPE     110, 
GO    TO     10 
CALL     PAUSEt 
REWIND    20 
CALL    BDEF(& 
RETURN 
RFTURN    1 
FORMAT     (•     I 
1CRIPT  IONS    W 
2X,»R    =    NUMB 
3«/9X, »B    =    M 
4    /  '     AT    EACH 
FORMATf 
F0RMAT( • 


NAME(*) 

(8,17)  ,DESC( 12,45  ),TYPE (45)  ,L  1ST (17) 

ISION    NAMES(45) 

(£50,&6  0,CAT,NUMC,MC,LIST  ) 

£50) 

UMC 
) 


) 

( 650,KNUM,NUM,MAXL,NG,DESC) 

NAMES  (  J) , TYPE( J) , (DESC(  I, J),  1  =  1, M 

(CAT( 1,KNUM) ,MC,MCL) 


AXL) ,J=1,NUM) 


30 

50 


60 
70 


»  o  «  i    l    i  ,  rxiiun  l    ,  il^  ,  riv,  t- 

AT( I ,KNUM), 1=1, MCL  ) 


.NUM)    GO    TO    30 

E,30).NE.0)    GO    TO    20 

£50) 

AT( I ,KNUM) ,1=1 ,MCL) 


TH(DESC(  1,LINE)  ,MAXL,MXL) 

NAMES (LINE), TYPE (L INE ) ,  ( DESC(  I , L I NE ) , I  =  1 , MXL ) 

£5C) 

60) 


90 
91 

100 
110 


1 


F0RMAT( •+ 
FORMAT  (IX, 
END 


N    EACH    CATEGORY,     THE    ITEM    NAMES,    TYPE 

ILL     BE*/1    LISTED.     TYPE    CODE S: ' /9X, • I 

ERS    WITH    FRACTIONAL    PARTS'^X^A    =    AL 

ULTIPLE    CHOICE    TYPES«/9X,«0    =    QUALIFI 

PAUSE    STRIKE    CR    KEY    TO    CONTINUE     ( STA 

CATEGORY:     • ,9A5> 

NAME    TYPE       DE SCR  I PTI ON • / '       ', 

,  | 

• ,T50,' (CCN' 'T)«  ) 
A7,1X,A1,2X,  12A5) 


0001177 
0001178 
0001179 
0001180 
0001181 
0001182 
00C1183 
00C1184 
0001185 
0001186 
00C1187 
0001188 
0001189 
0001190 
00C1191 
0001192 
0001193 
0001194 
0C0U95 
0001196 
0001197 
0001198 
0001199 
0001200 
0001201 
0001202 
0001203 
0001204 
0001205 
AND  DES0001206 
=  WHOLE  NUMBERS* /90001207 
PHANUMERIC  STR I NGS000 1208 
VALUES'0001209 
•)  0001210 
0001211 
0001212 
0001213 
0001214 
0001215 
0001216 


ED  NUMERIC 
RTING  NOW)  , 
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SUBROUTINE  NAME:  OBEY 

Purpose:   OBEY   associates   input  or  output  file  names  with 
FORTRAN    unit   numbers   and   provides   a   degree   of   file- 
name checking  and  protection. 
Calling  sequence:  CALL  OBEY(&m,MSG,N) 
Arguments : 

m — Statement   (in  caller)   to  which  a  branch  will  be  made 
if  a  protected   (output)   or  unknown   (input)   file  name  is 
referenced. 
MSG — Contains    (in   packed-character  form)    either   of   the 
following: 

"EQUATE  11  name,"  indicating  input, 
"EQUATE  12  name,"  indicating  output. 
N — The  number  of  words  in  MSG. 
Subroutines  culled:  KEYBRD,  IFILE,  OFILE 
Common,  data  referenced: 
IN,  IOUT  in  /IOUNIT/ 
FNAMES,  NUMI,  WHICH  in  /FILNAM/ 
Called  by:  RETRVE,  OPREP,  FTNC 
Error  checking  and  reporting : 

1.  Input  file  names  are  checked  for  recognition. 

2.  Output  file    names  are  checked   to   prevent   writing   on   a 
"protected"  file. 


3.  The  total  number  of  output  files  is  checked  against  the 
maximum  20. 

Error   messages   for    each   of   the   above   three   checks    are 
provided. 

Program  logic: 

1.  If  the  message  length  N  is  not  4  or  if  the  first  4  char- 
acters in  MSG  are  not  EQUA,  return  is  immediate. 

2.  MASTER  is  set  to  the  current  data-base  name  in 
/FILNAM/  and  MSG  is  moved  to  IMSG. 

3.  If  the  third  word  of  IMSG  is  not  "2,"  input  is  assumed, 
and  the  file  name  (last  word  of  IMSG)  is  checked  against 
the  names  of  files  created  during  this  session.  If  no  match 
is  found,  the  user  is  informed  and  given  the  opportunity  to 
exit  and  enter  a  new  command.  Finally,  IFILE  is  called  to 
associate  unit  23  with  the  file  name  provided. 

4.  If  the  third  word  of  IMSG  is  "2,"  output  is  assumed,  and 
the  file  name  FNAME  (last  word  in  IMSG)  is  checked 
against  the  list  of  protected  file  names  in  /FILNAM/.  If  a 
match  is  found,  the  nonstandard  return  is  taken.  Otherwise, 
FNAME  is  added  to  the  list  FILES,  and  unit  24  is  associ- 
ated with  the  file  FNAME  via  a  call  to  OFILE. 
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S  0  U  R  C  F 


PROGRAM 


SUBROUTINE    0 BEY( *, MSG, N )  3301217 

COMMON    /IOUNIT/     IN, IOUT  0001218 

COMMON    /FILNAM/    FNA MES , NUM I , WH ICH , P AD  0CC1219 
INTEGER    MASTER, FNAME,FILES<  20),MSG(  1) ,IMSG(4)  ,FNAMES(20)  ,WHICH  0301220 

1     ,PAD(4)  0001221 

EQUIVALENCE     (  I  MSG( 4 )  ,F NAME >  0001222 

DATA     I2,NUMF,  IEQ/^SG,  'E QU A  '  / , I  YES/ • Y • /  00C1223 

IF(N.NE.4>     GO    TO    100  C001224 

IF(MSG(  1  ).NE.IEQ>    GO    TO     100  0001225 

MASTbR=FNAMES(WHICH)  0001226 

DO    2    1=1,4  0001227 

2  IMSG(  I  )  =  MSG( I )  0001228 
IF(IMSG(3 ) . EQ. I  2  »  GO  TP  10  0001229 
IN=23  0001230 
IF(F\lAME.  EQ.  MASTER  )  GO  TO  6  0001231 
IF(NUMF.GT.O)    GO    TO    4  0001232 

3  TYPE  5C0  3301233 
CALL  KEYBRD( £100, I , 1)  0001234 
IF( I .EQ.IYES)    GO    TO    6  0001235 

8       RETURN     1  0001236 

4  DO  5  I=1,NUMF  3001237 
IF(FILES(  I  )  .EQ.FNAME)    GO    TO    6  0001238 

5  CONTINUE  0001239 
GO    TO    3  0001240 

6  CALL  IF ILE( IN, FNAME)  0001241 
GO    T3     100  3331242 

10  DO  11  J=l,5  C001243 
K=4*(J-1I  0001244 
DO  11  1=1, NUMI  0001245 
IFtFNAMES (K+I ) .EQ.FNAME J    GO    TO    14  0001246 

11  CONTINUE  0001247 
GO    TO     12  0001248 
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14    TYPE    501,FNAME  0001249 

GO    TO     8  0001250 

12  IF(NUMF.EQ.O)  GO  TO  20  0001251 
DO  13  I=1,NUMF  0001252 
IF(FILES( I ).EQ.FNAME)    GO  TO    21                                                                                                    0001253 

13  CONTINUE  0001254 

20  NUMF^NUMF+1  0001255 
IF(NUMF.LE.20)  GO  TO  22  0001256 
NUMF=20  0001257 
TYPE  23  0001258 
GO    TO     8  0001259 

22  FILES(NUMF>=FNAME  0001260 

21  I0UT=24  0001261 
CALL    0FILE(  IOUT,FNAME]  0001262 

100    RETURN  0001263 

23  FORMATM     NO    MORE    THAN    20  FILES    MAY    BE    CREATED    IN    ONE    RUN.' J                     0001264 
500               FORMAT(«     ATTEMPT    TO    REFERENCE    A    FILE    NOT    CREATED    THIS    RUN.'/            0001265 

1    ■     DO    YOU    STILL    WANT     IT?  (Y    OR    N):     ',$)                                                                            0001266 

501    FORMAT!  IX, A6, 'MAY    NOT    BE  USED    AS    AN    OUTPUT    FILE    NAME')                                   0001267 

END  0001268 
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SUBROUTINE  NAME:  OFILE 

Purpose:  This  subroutine  is  used  to  associate  dynamically  the 
name  of  a  new  data  set  with  a  FORTRAN  output  unit  num- 
ber (that  is,  logical  device  number).  When  this  subroutine 
is  called,  the  file  is  opened,  and  write  statements  referenc- 
ing the  unit  number  given  in  the  argument  list  are  directed 
to  the  named  file.  The  file  may  be  closed  by  use  of  a  rewind 
statement. 

Calling  sequence:  CALL  OFILE (I.NAME) 

Arguments : 

I — An  integer  variable  or  constant  specifying  a  logical  de- 
vice number. 


NAME — Either  a  literal  (hollerith)  constant  or  variable 
containing  a  file  name  consisting  of  five  or  fewer  char- 
acters. 

Subroutines  called:  None 

Common  data  referenced :  None 

Called  bij:  COLPNT,  OBEY 

Error  checking  and  reporting :  None 

Program  logic:  This  routine  is  a  DEC  1070,  TOPS-10  sys- 
tem resident  routine.  It  provides  the  capabilities  referred  to 
in  the  section  "Purpose"  above.  If  the  GRASP  system  is  to 
be  implemented  on  some  other  main  frame,  a  comparable 
routine  must  be  written  or  acquired.  Therefore,  a  listing 
has  not  been  provided. 
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SUBROUTINE  NAME:  OPREP 

Purpose:   This  routine  is  used  to  prompt  for  and  accept  the 

name  of  a  file  and  a  page  size. 
Calling  sequence:  CALL  OPREP (&n,&m,NPAGE) 
Arguments: 

n — Statement  number  (in  calling  routine)  to  which  a  branch 

will  be  made  if  an  EOF  is  sensed  by  KEYBRD. 
m — Statement  number  (in  calling  routine)  to  which  a  branch 
will  be  made  if  the  nonstandard  return  from  OBEY   is 
taken. 
NPAGE — Page  size  (in  lines)  as  entered  by  user. 
Subroutines  called:  KEYBRD,  OBEY,  ICONV,  PACK 
Common  data  referenced:  NAMES,  WHICH  in  /FILNAM/ 


Called  by:  DUMPIT,  LIST 

Error  checking  and  reporting:  An  error  flag  set  by  ICONV  is 

tested.  If  set,  the  user  is  requested  to  reenter  the  value. 
Program  logic: 

1.  A  file  name  is  prompted  for  and  accepted  (via  KEYBRD). 
This  name  is  then  packed  into  FNAME  and  compared  with 
blank. 

2.  If  blank,  FNAME  is  set  to  the  default  file  name  obtained 
in  /FILNAM/. 

3.  FNAME  is  then  passed  to  OBEY  via  EQUATE. 

4.  A  page  size  is  then  prompted  for  and  accepted  in  char- 
acter form.  The  numeric  value  is  obtained  by  a  reference 
to  ICONV.  If  zero,  then  NPAGE  is  set  to  10  million. 
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10 


15 

20 

3C 


SUBROUTINE    OPREP (*,* , NPAGE ) 
COMMON    /FILNAM/     FNAM ES , WH ICH , PAD 

INTEGER    DBLNK, DFAULT , FNAME , EQUATEC 4 ) ,TANK(5),FNAMES(21) 
1     ,PA0(4) 
LOGICAL     BAD 

EQUIVALENCE     ( EQUAT E (4 ) , FNAME ) 

DATA    DBLNK, EQUATE/'     •  , • EQUA •  ,  »TE    l','l'i'     •/ 
TYPE    20 

DFA UL T= FNAM ES( WHICH) 
CALL    KEYBRD(&15,TANK,5) 
CALL     PACK(T  ANK,  FNAME,  5,  5) 
IFIFNAME. 60. DBLNK)     FNAMfc=DFAULT 
CALL    OBEY(£18, EQUATE, 4) 
TYPE    30 

CALL     KEYBRD(£15,TANK,5) 
NP AG E= ICONV (TANK, 5,  I  ,BAD  ) 
IF    (BAD)    GO    TO    10 
IF     (NPAGE. EQ.C)     NPAGE= 10000000 
RETURN 
RETURN    1 

RETURN    2 
FORMAT     (•     ENTER    NAME    OF    FILE:     • , $) 
FORMAT     (•     ENTER    NUMBER    OF    LINES/PAGE:     ',$) 
END 


WHICH 


0001269 
3001270 
0001271 
0001272 
0001273 
0001274 
0001275 
0301276 
0001277 
0001278 
0001279 
0001280 
0001281 
0001282 
0001283 
0001284 
00C1285 
0301286 
0001287 
0001288 
0001289 
0001290 
0001291 
0001292 
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SUBROUTINE  NAME:  PACK 

Purpose:  All  user  input  to  the  GRASP  system  is  in  unpacked 
form  (in  other  words,  one  single  left- justified  character  per 
word).  PACK  is  used  to  convert  from  this  unpacked  form 
to  packed  form.  This  is  necessary  because  character  data 
in  files  accessed  by  GRASP  is  in  packed  form  to  conserve 
space. 

Calling  sequence:  CALL  PACK(SOURCE,DESTN,N,SIZE) 

Arguments: 

SOURCE — The   array    containing    the   unpacked    character 

string. 
DESTN — The  array  which  is  to  contain  the  packed  char- 
acter string. 


N — The  number  of  characters  to  pack. 

SIZE — The  size   (in  characters)    of  the  area  to  receive  the 
packed  data. 
Subroutines  called:  None 
Common  data  referenced :  None 
Called  by:  DRIVER,  COLPNT,  CONDTN,  DECOMP,  FILES, 

FTNC,  LOGEXP,  OPREP,  PARSE,  PNTER,  RELEXP, 

RETRVE,  VLIST 
Error  checking  and  reporting :  None 
Program  logic:  The  ENCODE  statement  is  used  to  move  the 

characters    from   the    unpacked    string    (SOURCE)    to    the 

packed  string  (DESTN). 


GRASP 


SOURCE 


PROGRAM 


SUBROUTINE    PACK(SOURCE,DESTN,N,SIZE) 

INTEGER    SOURCE(  1) ,DESTN(  1) , SIZE 

ENCODE (SIZE, 1, DESTN)     (SOURCE(  I), I=1,N) 

FORMAT! 80A1 ) 

RETURN 

END 


0001293 
0001294 
0001295 
0001296 
0001297 
0C01298 
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SUBROUTINE  NAME:  PARSE 

Purpose:    PARSE    converts   arithmetic  expressions  to   an  en- 
coded Reverse- Polish  form.  Extensive  syntax  checking,  con- 
version, and  preliminary  addressing  are  performed  to  facili- 
tate later  evaluation  by  EVAL.   The  arithmetic  expressions 
may    contain    the    usual    arithmetic    operators     (+, — ,*,/), 
numeric  constants,  item  names,  and  the  following  functions: 
ABS  (      ) — absolute  value ; 
SQRT  (      ) —square  root ; 
LOG  (     )— log  base  10; 
SQR  (     ) — square; 
TEN  (     )— power  of  10. 
Parentheses  may  be  used  for  grouping  to  control  the  order 
of  evaluation. 
Calling    sequence:    CALL    PARSE  (EXPR,L,TYPE,POLISH, 

I,ERR) 
Arguments: 

EXPR — Arithmetic    expression    to    be   parsed    in    unpacked 

character  form. 
L— The  length  of  EXPR. 

TYPE,   POLISH— Arrays   which   will   contain   the   encoded 
Reverse-Polish    form.    See    section    on    subroutine    EVAL 
for  additional  enco^ng  information. 
I— Length  of  TYPE  and  POLISH. 
ERR — Logical  flag  set  if  an  error  is  detected. 
Subroutines  called:  INIT,  FIND,  BFIND,  INCONV,  PACK 
Common  data  referenced:   NAMES,  IPNTS,   IDIM  in  blank 

common. 
Called  by:  PREVAL 

Error  checking  and  reporting:  The  expression  is  checked  for 
normal  FORTRAN-like  syntax  (such  as  balanced  paren- 
theses, binary  operators  bracketed  by  valid  names  or  expres- 
sions, and  correct  spelling  of  function  names).  The  message 
"ERROR  IN  EXPRESSION"  is  typed  if  an  error  is  detected. 
If  an  operand  or  function  name  is  not  recognized,  that 
message  is  typed. 
Program  logic:  The  logical  variable  CALLED  is  tested.  If  it 
has  not  been  set  by  a  previous  call,  it  is  set  to  .TRUE,  and 
INIT   is  called  to  "hash  code"  the  elements  of   SYMBOL 


into  CHARS  and  CODES.  Next,  the  variables  ERR,  ROW, 
TOP,  I,  and  C  are  initialized.  The  remainder  of  the  com- 
putation involves  scanning  EXPR,  an  element  at  a  time. 
As  in  LOGEXP,  a  transition-matrix  technique  is  used  to 
parse  the  expression,  converting  it  to  reverse-Polish  form. 
The  transition  matrix    (TM)    is  given  below: 


A-Z  +  /  * 

% 

1.  f(l)/2  f(8)/l   error      error      error 

2.  f(3)/2  f(4)/l  f(5)/l  f(6)/l  f(7)/l 

3.  error   f(4)/l  f(5)/l  f(6)/l  f(7)/l 


( 


) 


f (10) /l  error 
f(12)/l  f(9)/2 
error    f(9)/3 


blank 

f(2)/l 

f(2)/2 
f(2)/3 


0—9 

f(ll)/3 
f(  3)/2 
f(  3)/3 


where  the  f  (i)  are  separate  tasks  as  follows: 
f  (1) — Start  a  name. 
f(2) — Go  scan  next  character. 
f(3) — Append  current  character  to  name. 
f(4-7) — Binary  arithmetic  operator  sensed:    Set  CODE   to 
indicated   operator;   pop  stack   until   CODE    is  less   than 
the  topmost  stack  element;  push  CODE  down  on  stack. 
f(8) — Unary  minus  sensed:   set  CODE  and  push  down  on 

stack. 
f(9) — Right   parenthesis    sensed:    pop    stack    until    topmost 
element  is  code  for  left  parenthesis    (PAREN)  ;  decrease 
size  of  stack  by  one. 
f(10) — Left    parenthesis    sensed;    push    down    parenthesis 

code  PAREN. 
f  (11) — Digit  or  period  sensed:  start  a  constant.  NAME  is 

used  to  contain  the  constant  in  character  form, 
f  (12) — Left  parenthesis  sensed  in  row  2:  hence,  the  contents 
of  NAME  are  assumed  to  be  a  function  name.  Check  for 
validity  and  print  an  error  message  if  invalid;  otherwise, 
set  CODE  and  push  down  on  stack. 
The  proper  element  of  TM  is  selected  by  the  variables  ROW 
and  COLUMN.  The  COLUMN  value  is  determined  by  a  lookup 
(via  FIND)  of  the  current  character  and  the  ROW  value  is  set 
by  the  last  element  of  TM  referenced.  Once  the  proper  element 
of  TM  is  selected,  the  next  ROW  value  is  set  and  a  branch 
is  made  to  the  current  task. 

This  process  is  repeated  until  all  elements  of  EXPR  have 
been  processed.  See  the  section  on  subroutine  EVAL  for  details 
of  the  encoding  of  TYPE  and  POLISH. 


GRASP 


SOURCE 


PROGRAM 


SUBROUT INE 

COMMON    NAME 

DIMENSION    N 

1,9),     SYMBOL 

2(5),     CHARS! 

DOUBLE    PREC 

INTEGER    TM, 

10DES,CHAR,E 

LOGICAL    POP 

DATA     TM/12, 

122,23, 113, 3 

DATA    SYMBOL 

l^'O'  ,  '  Pf  ,• 

2'4', «5», *b* 

DATA    COLS/2 

DATA     IBLNK, 

DATA    PAREN, 


PARSECEXPR.Lf TYPE, POLISH, I, ERR) 

S,ITYPE, IPNTS, IDIM 

AMES1500),    POLISH!  11,    STACM41),    EXPRd 

(45),    C0LS(45),    TYPE(i),     ITYPE!500),     IP 

47)  ,    C0DES(47) 

ISION    NAMES, VARRLE ,DBLNK 

TOP, ROW ,COLUMN,ELEMNT,SWITCH,TYPE,C,COL 

XPR 

,NUM, ERR, CALLED 

32,0,81 ,2*41,0,2*51,0,2*61,0,2*71,101,1 

2,33/ 


0C01299 
0001300 

1,  NAME(8),  TM(300C130l 

NTS(50C),  IFNCTSC001302 
0001303 
0001304 

S,SYMBOL,CHARS,C0001305 
0001306 
0001307 

21,2*0,92,93,21,0001308 
0001309 
•M«  ,»N0001310 


•*  • 


6*1,11*9,8,3,2,5,4,6,7,  1/ 

CALLED, DBLNK/'  •,. FALSE.,'       •/ 

PLJS , DIFF,PROD,DI V, UNAR Y/0 . , - 1 . ,-2. , -  3, 


•*•  / 


-4. ,-5./ 


0001312 
0001313 
0001314 
0001315 
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DATA     IFNCTS/'ABS1 , 'SORT' , 'LOG' , 'SOR1 , •TEN'/  0001316 

IF    (CALLED)    GO    TO    20  0001317 

CALLED=.TRUE.  00C1318 

CALL     INITtCHARS, CODES, 47, SYMBOL, 45)  0001319 

20    ERR=. FALSE.  0001320 

R0W=1  0001321 

T0P=0  0001322 

1=0  3001323 

C=0  0001324 

30   C=C+1  0001325 

IF    (C.LE.L)    GO    TO     50  0001326 

IF     (ROW.EQ.l)    GO    TO    35C  0001327 

IF     (POP)    GO    TO     250  0001328 

IF    (NUM)    GO    TO    40  0001329 

SWITCH=1  0001330 

GO    TO    300  0001331 

40    SWITCH=2  0001332 

GO    TO     320  3001333 

50    CHAR=EXPR(C)  0301334 

CALL     FINDU350,  CHAR,  COLUMN,  CHARS,  CODES,  47)  0001335 

COLUMN=COLS(COLUMN)  0001336 

ELEMNT=TM(ROW, COLUMN)  0001337 

JOB=ELEMNT/10  0001338 

ROW=ELEMNT- 10*JOB  0001339 

GO    TO     (60,30,70,130, 140,150, 160, 170, 180, 23C24C, 270) ,     JOB  0001340 

GO    TO    350  0001341 

60    NAME(1)=CHAP  0001342 

NCHAR=1  0001343 

POP=. FALSE.  0001344 

NUM=. FALSE.  0001345 

GO    TO    30  C0C1346 

70    NCHAR=NCHAR+1  0001347 

NAME(NCHAR)=CHAR  0301348 

GO    TO    30  0001349 

80    IF     (POP)     GO    TO    100  0001350 

POP=.TRUE.  0001351 

IF     (NUM)     GO    TO    90  0001352 

SWITCH=3  0001353 

GO    TO    300  0001354 

90    SWITCH=4  0001355 

GO    TO    320  0001356 

100    IF     (TOP.EO.O)    GO    TO    120  0001357 

IF    (CODE.LT.STACK(TOP) )     GO    TO    120  0001358 

SWITCH=5  3001359 

VALUE=STACK (TOP)  0001360 

INDEX=VALUE  0001361 

GO    TO     330  0301362 

110    T0P=T0P-1  0001363 

GO    TO     100  0001364 

120    T0P=T0P+1  0001365 

STACK(TOP)=CODE  0001366 

GO    TO     30  3301367 

130    CO0E=DIFF  00C1368 

GO    TO    80  C001369 

140    CODE=PLUS  0001370 

GO    TO    80  0001371 

150    CODE=DIV  0001372 

GO    TO    80  0031373 

160    CODE=PROD  0001374 
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GO    TO    80  0001375 

17C    C0DE=UNARY  0301376 

GO    TO    120  0001377 

180    IF     (POP)     GO    TO    200  0001378 

POP=.TRUE.  0001379 

IF     (NUMI    GO    TO    190  0001380 

SWITCH=6  0001381 

GO    TO     300  0001382 

190    SWITCH=7  0001383 

GO    TO     320  00C1384 

200     IF     (TOP.EQ.O)    GO    TO     350  00C1385 

IF     (PAREN.EQ.STACK(TOP) )    GO    TO    220  0001386 

SWITCH=8  0001387 

VALUE=STACK(TOP)  0001388 

INDEX=VALUE  0001389 

GO    TO     330  0001390 

210    TOP=TOP-l  0001391 

GO    TO    200  0001392 

220    TOP=TOP-l  0001393 

GO    TO    30  0001394 

230    TOP=TOP+l  0001395 

STACK (TOP)=PAREN  0001396 

GO    TO    30  0001397 

240    NAME(1)=CHAR  0001398 

NCHAR=i  0001399 

NUM=.TRUE.  0G0140C 

POP=. FALSE.  0001401 

GO    TO     30  0001402 

25G    IF     (TOP.EQ.O)    GO    TO    370  0001403 

SWITCH=9  0001404 

VALUE=STACK(TOP)  0CC1405 

IF     ( VALUE. EQ.PAREN)  GO    TO    350                                                                                                       00C1406 

INDEX=VALUE  00C1407 

GO    TO    330  00C1408 

260    TOP=TOP-l  00C14C9 

GO    TO     250  0301^10 

270    IVALMBLNK  0001411 

IF     (NCHAR. EQ.O)     GO    TO    350  0001412 

CALL     PACMNAME,  IVAL , NCHAR , 4 )  0001413 

DO    280    J=l ,5  0001414 

IF    ( IVAL.EQ.IFNCTS( J) )     GO    TO    290  0001415 

280    CONT INUE  0001416 

TYPE    410,    IVAL  00C1417 

GO    TO     350  0001418 

290    CODE=J-ll  0001419 

TOP=TOP+l  0001420 

STACK (TOP )=CODE  0301421 

GO    TO    230  0001422 

300    VARBLE=DBLNK  0001423 

CALL     PACK (NAME, VAR BLE ,NCHAR , 8 )  0001424 

CALL    BF IND(&310 ,VARBLE, INDEX, NAMES, IPNTS, IDIM)  0001425 

GO    TO     330  0001426 

310    TYPE    390,     VARBLE  0301427 

GO    TO    360  0001428 

320    VALUE  =  ICONV(NAME, NCHAR  ,  J, ERR)  00C  1429 

IF     (ERR )     GO    TO    350  0001430 

INDEX=0  C001431 

IF    (J.NE.O)     VALUE=VALUF*10.**J  0301432 
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330     1=1+1  0001433 

IF    (I.LE.151    GO    TO    340  0001434 

TYPE    420  0301435 

GO    TO    350  0001436 

340    POLISHU  |=VALUE  0001437 

TYPE(  I!=INDEX  0001438 

GOTO     (250,250,  100,  100,110, 2C0t20C, 210,260,     SWITCH  0001439 

350    TYPE     380,     ( E XPR ( J >  ,  J=l  ,  L )  0001440 

360    ERR=.TRUE.  0001441 

370  RETURN  000 1442 

380  FORMAT  (•  ERROR  IN  EXPRESSION:  ' ,5CA1/23X ,30A1 !  0001443 

39C  FORMAT  (•  UNDEFINED  NAME  *,A8)  0001444 

410  FORMAT  <1X,A5,MS  NOT  A  PERMISSIBLE  FUNCTION.  HENCE*)  0001445 

420  FORMAT  (*  MORE  THAN  15  NAMES  AND  OPERATORS  USED.  HENCE*!           0001446 

END  0001447 
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SUBROUTINE  NAME:  PAUSE 

Purpose:  This  routine  is  used  to  provide  a  system-generated 
pause  in  output.  If  a  nonblank  character  is  entered  by  the 
user,  the  nonstandard  return  is  taken. 

Calling  sequence:  CALL  PAUSE (&n) 

Argument: 

n — Statement    (in  caller)    to  which  a  branch  will  be  made 
if  a  nonblank  character  is  returned  by  KEYBRD,  or  if 


the  nonstandard  return  is  taken  from  KEYBRD. 

Subroutine  called:  KEYBRD 

Common  data  referenced:  None 

Called  by:  BDEF,  COLPNT,  DUMPIT,  NAME,  ROWPNT 

Error  checking  and  reporting:  None 

Program  logic:  PAUSE  accepts  a  single  (left- justified)  char- 
acter from  KEYBRD.  If  an  EOF  is  sensed  or  the  character 
is  nonblank,  take  the  nonstandard  return. 
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SOURCE 


PROGRAM 


10 
1 


SUBRDUTINE    PAUSE(*> 

DATA     IBLNK/'     • / , I  BELL /" 0340CC000000/ 

TYPE     WIBELL 

CALL    KEYBRD<  &1C,I ,  1) 

IF     (I. EO. IBLNK)     RETURN 

RETURN     1 

FORMAT!  IX, A  1) 

END 


0DC1448 
G0G1449 
00C1450 
0001451 
0001452 
0001453 
3001454 
0001455 
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FUNCTION  NAME:  PNTER 

Purpose:  PNTER  is  used  to  look  up  user-entered  character- 
string  or  multiple-choice-type  values  in  the  value  part  of 
"conditions"  statements.  Lookup  is  performed  in  the  appro- 
priate dictionary,  and  the  value  returned  is  a  pointer  to  the 
particular  dictionary  item.  If  the  value  is  not  found,  an 
error  flag  is  set  and  zero  is  returned. 

Calling  sequence:  IPT  =  PNTER  (VALUE,  IDIM,  NAME, 
ITYPE,ERR) 

Arguments : 

VALUE — Unpacked  character-string  value  to  be  looked  up. 
IDIM— Length  of  the  string  in  VALUE. 
NAME — Item  number  for  which  the  character  string  repre- 
sents a  value. 
ITYPE— Item  type  of  item  pointed  to  by  NAME. 
ERR — Error  flag  which  is  set  if  the  value  is  not  found  in 
the  dicitionary  pointed  to  by  NAME. 

Subroutines  called:  ACCESS,  BINTYP,  PACK 

Common  data  referenced:  None 

Called  by:  RELEXP 


Error  checking  and  re-porting:  If  the  character-string  value  is 
not  found,  a  message  is  typed,  the  error  flag  is  set,  and 
zero  is  returned  as  the  value  of  PNTER. 

Program  logic:  If  the  length  of  the  string  is  given  as  zero, 
a  value  of  blank  is  returned  immediately.  Otherwise,  the 
string  is  packed  into  STRING.  The  value  of  ITYPE  then 
determines  whether  the  character-type  dictionaries  should 
be  accessed  (via  ACCESS)  or  the  multiple-choice-type  dic- 
tionaries should  be  accessed  (via  BINTYP).  If  a  character- 
type  dictionary  is  indicated,  a  call  to  ACCESS  is  made, 
where  the  fifth  parameter  has  a  value  of  3.  This  returns  K 
as  the  pointer  to  the  first  dictionary  item.  ACCESS  is  then 
called,  using  the  value  4  as  the  fifth  parameter  (which  re- 
turns the  K'th  entry  and  updates  K  to  point  to  the  next 
entry),  until  all  entries  have  been  returned  or  until  a  match 
is  found.  If  a  match  is  found,  the  entry  number  is  returned 
as  a  value.  Otherwise,  zero  is  returned  as  a  value,  and  the 
nonstandard  return  is  taken.  If  a  multiple-choice-type  dic- 
tionary is  indicated,  a  call  to  BINTYP  returns  the  possible 
values  in  LABEL.  The  string  (equivalenced  to  BLABEL)  is 
then  compared  with  the  items  of  LABEL. 


GRASP 


SOURCE 


PROGRAM 


INTEGER    FUNCT IONPNT ER ( V  ALU E, I  DIM , N AME,  I T YPE ,ERR ) 

DOUBLE    PRECISION    LAREL ( 25  ), BLABEL 

INTEGER    VALUE<  1 ),TANK( 25>,BITEM( 15,25)  ,STRING<12) 

LOGICAL    ERR 

EQUIVALENCE     < STRI NG ( 1 ), BLABEL) 

DATA     IBLNK/'     •/ 

ERR=. FALSE. 

N=IBLNK 

IF    (  IDIM.EQ.O)    GO    TO     HO 

DO    10     1=1 ,12 
10    STRING( I )=IBLNK 

CALL    PACK(VALUE,STR  ING,  IDIM, 60) 

DO    20    1=1  ,12 

IF    ( STRING! 13-1 ).NE. IBLNK)    GO    TO    30 
20    CONTINUE 

GO    TO    110 
3C    LENGTH=13-I 

IFUTYPE-3)    35,35,80 
35  CALL    ACCESS<NAME,K,TANK,NUM,3) 

N=0 
*C  IF(K.EQ.O)    GO    TO    60 

N  =  N+1 

CALL     ACCESS (N AM E, K , T ANK , NW0RD S, 4) 

IF    (NW0RDS.LT. LENGTH)     GO    TO    40 

DO    50    1=1, LENGTH 

IF    (TANK(  I)  .NE.STR ING(  I )  )    GO    TO    40 
50    CONTINUE 

GO    TO     110 
60    ERR=.TRUE. 

TYPE     130,     ( VALUE( I )  ,  1  =  1 ,IDIM) 

GO    TO     100 
80    CALL    BINTYP(NAME, LABEL, BITEM,L,M) 

DO    90    N=1,M 

IF  ( BLABEL. EQ.LABEL(N) )  GO  TO  110 


0C01456 
0001457 
000U58 
00C1459 
00G1460 
0001461 
00C1462 
0001463 
0001*64 
0001465 
0001466 
0001*67 
0001468 
0001469 
00C1470 
0001471 
0001*72 
0001473 
0001474 
O0OU75 
0001476 
00C1477 
0001478 
0001479 
0001480 
0001*81 
0001482 
000  1483 
0001484 
0001485 
00Cl*86 
0001487 
0001488 
0001489 
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90    CONTINUE  0001490 

TYPE     140*    BLABEL  00C1491 

ERR=.TRUE.  0001492 

100    N=0  0001493 

110    PNTER=N  0001494 

RETURN  0001495 

130    FORMAT     (•     CHARACTER    TYPE    VARIABLE    DOES    NOT    ASSUME    VALUE :•/ IX, 60A 1 ) 0001496 

140    FORMAT    (•     BINARY    TYPE    VARIABLE    DOES    NOT    ASSUME    VALUE    • , A8 )  0001497 

END  0001498 
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SUBROUTINE  NAME:  PREVAL 

Purpose:  PREVAL  acts  as  an  interface  between  the  calling 
routine  (VLIST)  and  the  arithmetic-expression  parsing 
routine  PARSE.  This  interface  allows  a  reduction  in  the 
number  of  dimensions  for  the  variables  in  /EXPRNS/ 
which  contain  the  Reverse-Polish  form  of  the  arithmetic 
expressions  entered  by  the  user. 

Calling    sequence:    CALL    PREVAL (&n,IEXPR,L,KNT) 

Arguments: 

n — Statement  (in  calling  routine)  to  which  a  branch  is  made 

if  the  routine  PARSE  sets  an  error  flag. 
IEXPR — Contains    (in   unpacked   character    form)    the   ex- 
pression to  be  parsed. 
L— The  length  of  IEXPR. 


KNT — Arithmetic  expression  counter. 
Subroutine  called:  PARSE 
Common     data     referenced:      POLISH,      ITYPE,      LPS     in 

/EXPRNS/ 
Called  by:  VLIST 
Error    checking    and    reporting:    Error    flag    returned    from 

PARSE  is  tested. 
Program  logic: 

1.  The  expression  counter  KNT  is  incremented. 

2.  Call  PARSE,  passing  the  input  arguments  IEXPR,  L,  and 
the  KNT'th  columns  of  ITYPE,  POLISH  along  with  the 
KNT'th  element  of  LPS,  and  an  error  flag. 

3.  Take  the  nonstandard  return  if  the  error  flag  ERR  has  been 
set. 
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PROGRAM 


SUBROUTINE    PR EVALC *  ,  I  EXPR , L , KNT ) 

COMMON    /EXPRNS/    POL  I SH , I  TYPE , LPS 

DIMENSION    POLISH(15,8),     ITYPE(15,8),    LPS(8),     IEXPR(l) 

LOGICAL    ERR 

KNT=KNT+1 

CALL    PARSE! I  EXPR, L , ITYP E( 1,KNT ), POLISH! 1,KNT) ,LPS(KNT) , ERR  J 

IF    (ERR)    RETURN    1 

RETURN 

END 


0001499 
0001500 
0001501 
0001502 
00C1503 
0001504 
0001505 
0001506 
0001507 
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SUBROUTINE  NAME:  QUIT 

Purpose:  QUIT  performs  "wrap-up"  processing  prior  to  exiting 
from  the  GRASP  system.  This  involves  a  typed  statement 
regarding  the  disposition  of  files  created  during  the  current 
session. 

Calling  sequence:  CALL  QUIT(OFILES.NFILES) 

A  rgu  ments : 

OFILES — List  of  output  files  created  during  this  session. 
NFILES— The  number  of  items  in  OFILES. 

Subroutines  called:  KEYBRD,  RLIST 

Common  data  referenced:  None 

Called  by:  DRIVER 


Error  checking  and  reporting:  The  user's  response  to  prompts 

is  checked  for  validity. 
Program  logic: 

1.  The  list  of  created  file  names  is  typed,  and  the  user  is 
asked  if  he  would  like  to  save  any  of  them. 

2.  If  so,  he  is  asked  to  enter  a  list  of  numbers  corresponding 
to  those  files  he  wishes  to  save. 

3.  The  system  then  instructs  him  how  to  delete  the  files  he 
does  not  wish  to  save.  This  routine  is  provided  primarily  for 
bookkeeping.  The  file-maintenance  functions  can  be  per- 
formed at  the  program  level  on  those  systems  having  this 
capability. 
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SUBROUTINE    QUIT  (OF  I  L  ES  ,  NF  IL  ES  ) 

DIMENSION    IMAGE(30) ,LIST(20),     KLIST(20) 

INTEGER    0FILES(20),FILE,YES,REPLY 

DATA    YES,NO/,Y»  ,  •NV 

IF    (NFILES. EQ.O)    GO    TO    100 

TYPE     110,     (  1, 0FILES(  I»t  1=1, NFILES) 

TYPE    120 
10    TYPE     130 

CALL    KEYBRD<&100,  REPLY,  1) 

IF     (REPLY. EQ. YES)     GO    TO    40 

IF    (REPLY. E0. NO)    GO    TO    20 

TYPE     150 

GO    TO     10 

NKILL=NFILES 

00    3C     1=1, NFILES 

KLIST( I )=I 

GO    TO     80 

IF    (NFILES. EQ. 1 )    GO    TO     100 

TYPE     160 

CALL    KEYBRD( &100, IMAGE, 30) 

CALL    RLIST(£50,IMAGE,LIST,NSAVE,20) 

IF    (NSAVE.EO.C)    GO    TO    20 

NKILL=0 

DO    70    1=1, NFILES 

DO    60    J=1,NSAVE 

IF    (LIST(J) .EQ.I )     GO    TO    70 

CONTINUE 

NKILL=NK ILL+1 

KLIST(NKILL )=I 

CONTINUE 

IF    (NK  ILL  )     100,  100,80 

TYPE    90,(0FILES(KLIST(I )  )  , I  =  1,NKILL) 

RETURN 

•     ISSUE     .DEL    COMMANDS    FOR    THE    FOLLOWING    FILE 
(//»     THE    FOLLOWING    FILES    HAVE    BEEN    CREATED    ' 
1ESSI0N: »/(I 5,5X,A6) ) 
120     FORMAT     (//•     DO    YOU    WISH 


20 


30 


40 


50 


60 


70 


100 


110 


F0RMAT( 
FORMAT 


S:« /(1X,10A6)  ) 
,'DURING    THIS 


13C  FORMAT 
150  FURMAT 
160    FORMAT 


(• 
(  ' 
<■ 


1    YOU 
END 


WI  SH 


TO    SAVE    ANY    CF     THEM?' ) 
( ENTER    YES    OR    NO) :     ■  ,$) 
YOUR    REPLY    WAS    NOT    UNDERSTOOD.1) 
ENTER    A    LIST    OF    NUMBERS    CORRESPONDING 
TO    SAVE    ( IE.     1-3,5 ).' ) 


TO  •/•  THOSE 


0001508 
0001509 
0001510 
0001511 
0001512 
0001513 
0001514 
3001515 
0001516 
0001517 
0001518 
0001519 
0001520 
0001521 
0001522 
0001523 
3301524 
0001525 
0001526 
0001527 
0001528 
0001529 
000153C 
0001531 
0001532 
C001533 
0001534 
0001535 
0001536 
3001537 
0001538 
0001539 
3301540 
0001541 
S00C1542 
3301543 
0001544 
0001545 
00C1546 
FILES0001547 
0001548 
3001549 
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SUBROUTINE  NAME:  RELEXP 

Purpose:  This  subroutine  is  used  to  decode  the  "condition" 
appearing  in  IMAGE  into  the  components  NAMEPT, 
RCODE,  and  IVAL.  If  it  is  unsuccessful,  an  error  message 
is  typed  and  an  error  flag  is  set.  The  "condition"  is  in 
unpacked  character  form  and  is  assumed  to  be  a  name 
followed  by  a  relation  followed  by  a  value.  Name  must  be 
an  item  name  in  the  current  data  base  (as  established  by  the 
file  command).  Relation  must  be  one  of  the  following:  EQ, 
equal;  LT,  less  than;  GT,  greater  than;  LE,  less  than  or 
equal;  GE,  greater  than  or  equal;  NE,  not  equal;  BE,  be- 
tween. Vahie  must  be  a  number,  number  pair,  character 
string,  set  of  qualifiers,  permissible  multiple-choice  acronym, 
or  blank.  The  following  table  gives  valid  constructions  for 
"conditions" : 

Item  type  Relation  Value 

Integer  or  real...      EQ,    LT,    GT,    LE,    GE,   NE..      Numeric. 

BE     Numeric   pair. 

Character EQ,   LT,    GT,    LE,    GE,    NE..     Any  printable  string. 

BE      Printable  string  con- 
taining comma. 

Multiple  choice  ._      EQ,   NE    Multiple-choice 

acronym. 

Qualified  real EQ,   LT,    GT,    LE,    GE,    NE_.      Numeric. 

BE     Numeric   pair. 

EQ,   NE   Qualifier  set1  in 

parentheses. 

1  Qualifier    set    is    one    or    more    of    the    following    characters,    each    of 
which    occur,    at    most,    once;    G,    H,    L,    N,    T,    or    blank. 

Calling    sequence:     CALL     RELEXP  (&n,IMAGE,NAMEPT, 

RCODE,IVAL,ERR) 
Arguments : 

n — Statement  number  (in  calling  routine)  to  which  a  branch 
will  be  made  if  an  all-blank  condition  is  detected. 

IMAGE — Contains  "condition"  in  unpacked-character  form. 

NAMEPT — Returned  pointer  to  item  name. 

RCODE — Returned  encoding  of  relation  having  the  follow- 
ing possible  values : 
1-7  corresponding  to  the  relations 
EQ,  LT,  GT,  LE,  GE,  NE,  BE. 

11    or    16    corresponding    to    the    relations    EQ    or    NE, 
applied  to  a  set  of  qualifiers. 

IVAL — Returned  as  one  of  the  following: 

1.  Integer  or  real  value. 

2.  Pointer  to  a  particular  entry  in  the  character  dictionary 
associated  with  the  item  pointed  to  by  NAMEPT. 

3.  Bit  encoding,  giving  the  position  of  a  particular  multiple- 
choice  acronym  in  the  file  containing  possible  acronym 
values  for  the  item  pointed  to  by  NAMEPT. 

4.  Pointer  to  the  number  pair  in  the  common  block  BTWN 
which  will  be  used  by  this  instance  of  the  BE  relation. 

5.  Bit  encoding  of  a  qualifier  set. 

ERR — Returned  error  flag  that  is  set  if  an  error  is  detected. 
Subroutines  called:  SCAN,  BFIND,  ICONV,  PNTER,  PACK 
Common  data  referenced: 


NAMES,  ITYPE,  PNTERS,  IDIM  in  blank  common 

IVALS,  NBEin/BTWN/ 
Called  by:  CONDTN 
Error  checking  and  reporting : 

1.  All  testing  is  performed  to  insure  conformity  to  the  table 
of  valid  constructs  appearing  in  the  preceding  "purpose" 
section. 

2.  An  error  flag  that  may  be  set  by  the  routines  ICONV  or 
PNTER  is  tested. 

3.  A  nonstandard  return  from  BFIND  indicates  an  invalid 
name. 

An  error  message  is  printed  reporting  any  of  the  following 
errors : 

a.  Unable  to  find  relation  (that  is,  EQ,  LT,  GT,  LE,  GE, 
NE,  BE). 

b.  Incorrect  qualifier  set. 

c.  Qualifier  codes  are  referenced  in  forms  other  than  EQ 
or  NE. 

d.  Invalid  name  as  first  syntactic  unit  of  condition. 

e.  No  comma  separating  a  value  pair  used  with  the   BE 
relation. 

Program  logic: 

1.  A  call  to  SCAN  is  made  to  bracket  the  name  as  the  first 
syntactic  element.  If  the  image  is  all  blank,  the  nonstandard 
return  is  taken. 

2.  The  name  is  packed  into  NAME  via  ENCODE,  and 
BFIND  is  used  to  do  the  lookup.  If  the  name  is  not 
found,  a  message  is  typed,  and  the  error  flag  is  set. 

3.  The  next  call  to  SCAN  brackets  the  relation.  It  is  packed 
into  REL  and  tested  against  the  list  of  valid  relations.  Note 
that  RCODE  is  used  as  the  index.  If  invalid,  a  message  is 
typed,  and  the  error  flag  is  set. 

4.  The  value  part  of  the  condition  is  then  bracketed  via  the 
next  call  to  SCAN.  If  the  value  field  is  blank,  IVAL  is  set 
to  blank. 

5.  Otherwise,  the  type  of  name  is  determined  using  ITYPE 
in  blank  common. 

6.  The  logical  variable  BE  (indicating  the  "between"  rela- 
tion) is  determined.  If  set,  the  second  value  is  determined 
and  stored  in  the  BTWN  common  area,  and  IVAL  is  set 
to  point  to  the  BTWN  location.  The  second  value  deter- 
mination is  logically  similar  to  the  first  which  is  described 
in  step  8. 

7.  If  BE  was  not  set,  the  value  element  is  tested  as  a  qualifier 
set.  If  it  is  one,  the  appropriate  tests  are  made,  and  IVAL 
is  bit  encoded  to  show  which  codes  are  present.  RCODE  is, 
also,  incremented  by  10  as  a  flag  indicating  comparison  of 
qualifier  cores. 

8.  If  the  value  element  was  not  a  qualifier  set,  and  the  rela- 
tion was  not  BE,  IVAL  is  set  via  a  call  to  ICONV,  if  type 
was  numeric.  Note  that  for  real  values,  VAL  (equivalenced 
to  IVALL)  is  set.  IVAL  is  then  set  by  IVALL,  which  shares 
storage  with  VAL.  For  character  and  multiple-choice  types, 
IVAL  is  set  using  the  external  function  PNTER. 
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SUBROUT INE    RELEXP ( *, IMAGE, NAMEPT, RCODE , IVAL ,ERR J 
COMMON    NAMES, ITYPE, PNTERS, IDIM 
COMMON    /BTWN/     IVALS, NBE 
DIMENSION    RELS(7),     IVALS(2,10), 


IMAGEC80J,     ITYPE(500), 


0001550 

0001551 

0001552 

NAMESJ500)    0001553 
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DOUBLE  PRECISION  NAME , NAMES , DBLNK  0001554 
INTEGER    FCNAME,FC0P,FCCON,RCODE,PNTER,BLANK,PNTERS(500)  ,  E  ,REL,RELS00015  55 

1, COMMA, RPAREN,IQUAL(6)  0001556 

LOGICAL    ERR, BE  0001557 

EQUIVALENCE    ( VAL , I VALL ) , ( IQUAL , BLANK)  0001558 

DATA    COMMA, RPAREN,LPAREN, DBLNK, IQUAL/* ,*,' ISM' ,'                   »,  0001559 

1     •     ',  «G»,  «H  »,  'LS'NS'T'/,  0001560 

1    RELS/'EQ1, 'LTS • GT • , 'LE', 'GE', 'NE', 'BE'/  0001561 

ERR=. FALSE.  0001562 

1=1  0001563 

CALL    SCANU295,  IMAGE,  I,  FCNAME  ,LCNAME,  1  I  00C1564 

NAME=DBLNK  0001565 

CALL     PACK(IMAGE(FCNAME ) ,NAME , LCNAME-FC NAME*  1, 8)  30C1566 

CALL    BFINDUllO,  NAME,  NAMEPT,  NAMES,  PNTERS,  IDIM)  0001567 

I=LCNAME+1  0001568 

CALL    SCAN<£20, IMAGE,  I,FCOP, J, 1)  0001569 

IF( J.NE.FCOP+1)    GO    TO    20  0001570 

REL=BLANK  0001571 

CALL    PACK(IMAGE(FC0P),REL,2,4)  0001572 

DO    10    RC0DE=1,7  0001573 

IF(RELS(RCODE).EQ.REL)    GO    TO    30  00C1574 

10    CONTINUE  0001575 

2C    TYPE     320  0001576 

GO    TO     144  0001577 

30    I=J  +  1  0001578 

CALL     SCAN(£40,IMAGE,I , FCC  ON , LCC0N,2)  0001579 

GO    TO     140  000158C 

40    IVAL=BLANK  00C1581 

GO    TO    210  0001582 

295    RETURN    1  0001583 

140    J=ITYPE(NAMEPT)  0001584 

BE=RC0DE.EQ.7  0001585 

IF(BE)    GO    TO    220  0001586 

IF( IMAGE(FCCON) .NE.LPAREN)     GO    TO    150  0001587 

IF(J.NE.5)    GO    TO    150  0001588 

IF( IMAGE(LCCON) .EQ.RPAREN)     GOTO    142  0001589 

1405    TYPE     141  0001590 

GO    TO    144  0001591 

142    IF(RCODE.EQ.l)     GO    TO    145  0001592 

IF(RC0DE.EQ.6)    GO    TO    145  0001593 

TYPE     143  0001594 

144  ERR=.TRUE.  0001595 
GO    TO     210  0001596 

145  RCODE=RCODE+10  0001597 
IVAL=0  0001598 
FCC0N=FCC0N+1  0001599 
LCC0N=LCC0N-1  0001600 
DO  147  K=FCCON,LCCON  0001601 
J=IMAGE(K)  0001602 
DO  146  1=1,6  0001603 
IF{  IQUAK  I  ).EQ.  J)     GO    TO    147  0001604 

146  CONT  INUE  0001605 
GO    TO     1405  0001606 

147  IVAL=IVAL+2**(I-1)  0001607 
GO    TO    210  0001608 

110    TYPE    310,    NAME  0001609 

GO    TO     144  0001610 

150    GO    TO     (160, 170, 190, 19C, 170) , J  0001611 

160    I VAL=ICONV( IMAGE(FCCON) , LCCON-FCCON+1 , E, ERR )  0001612 

GO    TO     200  3D01613 
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170    K=ICONV( IMAGE(FCCON) ,  LCC0N-FCC0N  +  1  , E,ERP)  0001614 

IF    (K.NE. BLANK)    GO    TO    180  0001615 

IVAL=K  0001616 

GO    TO    200  0001617 

180    VAL=K*1C.**E  00C1618 

IVAL=IVALL  0001619 

GO    TO    200  0001620 

19C     IVAL=PNTER( IMAGE(FCCON) , LCCON-FCCON+1 , NAMEPT , J, ERR)  0001621 

200     IF    (FRR)    GO    TO    210  0001622 

IF     (.NOT. BE)     GO    TO    210  0001623 

NBE=NBE+1  0001624 

I VALS <1,NBE)=IVAL  0001625 

IVAL=NBE  0001626 

210    RETURN  0001627 

220    DO    230    I=FCCON,LCCON  0001628 

IF    (  IMAGEU  ).EQ. COMMA)     GO    TO    240  0001629 

230    CONTINUE  0001630 

TYPE    330  0001631 

GO    TO     144  0001632 

24C    GO    TO    (250,260»280, 280, 260)  ,J  0001633 

250    I VAL=ICONV{ IMAGEt 1+1) ,LCCCN-I, E,EPR)  0001634 

GO    TO    290  0001635 

260    K=ICONV(  IMAGE(I«-l),LCCON-I,E»ERR)  0001636 

IF  (K.NE. BLANK)  GO  TO  270  0001637 

IVAL=K  0001638 

GO  TO  290  00C1639 

270  VAL=K*10.**E  00C1640 

IVAL=IVALL  0001641 

GO    TO    290  0G01642 

280    IVAL=PNTER(  IMAGE(I+1) ,LCCON-I , NAMEPT, J, ERR)  0001643 

290     IF    (ERR)    GO    TO    210  0001644 

I VALS<2 ,NBE+l)=IVAL  000  1645 

LCCON=I-l  0001646 

GO  TO  150  3001647 

141  FORMATC  QUALIFIER  CODES  MUST  BE  ONE  OR  MORE  OF  "L,  ,N,T,G,H"%    0001648 

1  •  AND  ENCLOSED  IN  PARENTHESIS.')  0001649 

143  FORMATC  ONLY  EO/NE  CAN  BE  USED  WITH  QUALIFIER  CODES.  •)  0001650 

31C  FORMAT  (•  INVALID  NAME  =  • tA8l  0001651 

32G  FORMATC  UNABLE  TO  FIND  RELATION  (  LT,GT,  LE,  GE  ,EQ,NE  ,  BE  »  •  )  0001652 

330  FORMAT  (•  NO  COMMA  SEPARATING  CONSTANTS  FOLLOWING  BE  OPERATOR*)    0001653 

END  0001654 
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SUBROUTINE  NAME:  RETRVE 

Purpose:  RETRVE  is  used  to  retrieve  records  from  a  selected 

file  and  write  them  on  some  other  selected  file.  User-specified 

encoded  retrieval   criteria  are  passed   to   RETRVE   via  its 

argument  list. 

Calling  sequence:   CALL  RETRVE  (&n,&m,IFILES,OFILES, 

NFILES,POLISH,LPS,VARS,CODES,VALS,NCOND) 
Arguments: 

n — Statement  number  (in  calling  routine)  to  which  a  branch 
is  made  if  previously  undetected    (by   LOGEXP)    errors 
are  encountered, 
m — Statement  number  (in  calling  routine)  to  which  a  branch 

is  made  if  KEYBRD  senses  an  EOF. 
IFILES,  OFILES — Arrays  of  input  and  output  file  names, 

respectively. 
NFILES— Number     of     elements     in     either     IFILES     or 

OFILES   (IFILES  and  OFILES  are  of  equal  size). 
POLISH — Array  containing  the  Reverse-Polish  form  of  the 

logic  expression  to  be  used  for  data  retrieval. 
LPS— The  number  of  elements  in  POLISH. 
VARS,  CODES,  VALS— Arrays  that  give  an  encoding  of 

the  conditional  expressions  entered  by  the  user. 
NCOND— Number    of    elements    in    VARS,    CODES,    and 
VALS. 
Subroutines    called:    KEYBRD,    OBEY,    GETPUT,    COMP, 

UNCODE,  PACK 
Common  data  referenced: 

FNAMES,  SELECT  in  /FILNAM/ 
ITYPE  in  blank  common 
INPUT,  OUTPUT  in  /IOUNIT/ 
Called  by:  DRIVER 
Error  checking  and  reporting: 

1.  Check  to  assure  entry  of  retrieval  criteria  (that  is,  LPS>0) 

2.  Check  to  assure  absence  of  undetected  errors  in  the   re- 
trieval criteria. 


Messages  are  typed  corresponding  to  the  two  error  situa- 
tions above. 
Program  logic: 

1.  LPS  is  checked  to  insure  that  retrieval  criteria  have  been 
entered. 

2.  The  elements  of  VALS  are  moved  to  IVAL  to  allow  the 
equivalencing  necessary  for  mixed  modes  (in  particular, 
integer  and  real)  possible  in  retrieval  criteria. 

3.  Input-  and  output-file  names  are  prompted  and  accepted, 
then  associated  with  FORTRAN  unit  numbers  via  calls  to 
KEYBRD  and  OBEY.  The  new  file  names  are  added  to 
IFILES  and  OFILES. 

4.  The  input  file  is  then  read,  one  record  at  a  time  (via 
GETPUT),  until  the  nonstandard  (EOF)  return  is  taken. 
After  each  call  to  GETPUT,  the  record  (IREC)  is  tested 
against  the  retrieval  criteria  indicated  in  POLISH,  VARS, 
CODES,  and  VALS  via  the  logical  valued  push-down  stack 
technique  described  as  follows:  Any  element  of  POLISH 
less  than  27  points  to  one  of  the  conditional  expressions  en- 
coded in  VARS,  CODES,  VALS.  That  expression  is  evalu- 
ated via  a  reference  to  the  logical  function  COMP,  and  the 
result  is  placed  in  the  push-down  stack.  If  POLISH  (I)  >26, 
it  points  to  one  of  the  logical  operators  "and,"  "or,"  "not" 
(denoted  by  *,  +,  — ).  If  the  operator  is  — ,  the  "not"  op- 
eration is  performed  on  the  topmost  stack  element.  If  the 
operator  is  *  or  +,  the  operation  is  performed  on  the  top- 
most two  stack  elements,  the  size  of  the  stack  is  decremented, 
and  the  resultant  (logical)  value  replaces  the  new  topmost 
stack  element.  After  the  last  element  of  POLISH  has  been 
processed,  the  size  of  the  stack  should  be  1,  and  the  value 
of  this  element  indicates  whether  or  not  the  record  meets 
the  retrieval  criteria.  If  so,  it  is  added  to  the  output  file 
by  a  call  to  GETPUT.  Counts  of  records  read  and  records 
retrieved  are  kept  and  typed  at  the  end  of  retrieval  process- 
ing. 
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SOURCE 


PROGRAM 


10 
20 


SUBROUT 
1VALS,NC 
COMMON 
COMMON 
COMMON 
DIMENSI 
DOUBLE 
INTEGER 
1ISH(1 ), 
INTEGER 
LOGICAL 
EQUIVAL 
DATA  ON 
IF  (LPS 
TYPE  18 
GO  TO  1 
DO  20  I 
IVAL( I ) 
DFAULT= 
NRECS=0 
NF0UND= 


INE    RETRVE ( *, *, I FIL ES, OF IL E St NF IL ES, POL  I SH , LPS , VARS, CODE S , 

OND) 

NAMES, ITYPE, IPTS,IDIM 

/IOUNIT/     INPUT, OUTPUT 

/FILNAM/    FNAMES, SELECT, PAD 

ON    VAL(26) 

PRECISION    NAMES(5GG) 

IVAL  (26)  ,CODES(  1)  ,VARS(il , WHICH, DREC( 500 ), OUT  PUT , TOP, POL 
ITYPE(500),0NE,TW0,VALS( 1) , EQUA TE( 4) , I PT S( 500 ) .SELECT 

FILEID,DBLANK, IFILES( 1 ) ,0F IL ES ( 1 ), DFAULT , FNAMES ( 21) 

COMP, VALUE ,STACK( 20) ,EVAL,PAD(4) 
ENCE     (  IRECREC),  (  IVAL,  VAL  ),  (STACK  ,  EVAL  ) ,  (  EQUATE  (  4  )  ,FI  L  EI  D) 


E , TWO,DBLANK/,li 

.GT.0)    GO    TO    10 

0 

70 

=1, NCOND 

=  VALS(I  ) 

FNAMES(SELECT) 


EQUATE/'EQUA' , 'TE  l',2*'  •/ 


0001655 
0001656 
0001657 
0001658 
0001659 
0001S60 
00C1661 
0001662 
00C1663 
00C1664 
0001665 
0001666 
0001667 
0001668 
0001669 
0001670 
0001671 
0001672 
0001673 
0001674 
0001675 
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NFILES=NFIL  ES+1  00C1676 

EQUATE(3l=ONE  0001677 

TYPE     190  0001678 

CALL    KEYBRD(£175,DREC,5)  0001679 

CALL     PACK(DREC,FILEID,5,5)  0001680 

IF    (F ILEIO.EO.DBLANK)     F I LE I D=DF AULT  0001681 

IFILES(NFILFS)=FILEID  0001682 

CALL    0BEYU170, EQUATE, 4)  0001683 

EQUATE(  3)=TW0  0001684 

TYPE    210  00C1685 

CALL    KEYBRDU175,DREC,5)  0001686 

CALL     PACK (DREC, FILEID, 5,5)  0001687 

OFILES(NFILES)=FILEID  0001688 

CALL    0BEYU170, EQUATE, 4)  0C01689 

30    CALL     GETPUTU140,DREC,  1)  00C1690 

NRECS=NRECS+1  0001691 

TOP=0  0001692 

DO    110     J=1,LPS  0001693 

INDEX  =  POLISH(  J)  0001694 

IF     ( INDEX. GT. 26)    GO    TO    70  0001695 

T0P=T0P+1  0001696 

WHICH=VARS( INDEX)  0001697 

I=ITYPE(WHICH)  0001698 

IREC=OREC(WHICH)  0001699 

GO    TO     (40,50,40,60,62),     I  0001700 

40    STACK(TOP)=    COMPUREC  ,  I  VAL  (  I  NDE  X)  ,  Dl  ,D2  ,CODES(  INDEX  )  ,  I  )  0001701 

GO    TO    110  0001702 

50    STACK(TOP)=    COMPC I Di , I D2 , REC  ,VAL ( I NDEX ) , CODES  (  INDEX  )  ,2  )  0001703 

GO    TO    110  0001704 

6C     STACK(TOP)=    COMPd REC  , IV AL (  INDEX ), Di , D2, CODES  (  INDEX ), 3 )  00017C5 

GO    T3     110  0001706 

62  IF(  IREC.NE.DBLANK)  GO  TO  63  0001707 
IF(CODES( INDEX) .LT. 11)  GO  TO  50  0001708 
STACK (TOP )= .FALSE.  0001709 
GO    TO    110  000171C 

63  REC=UNCODE(REC, IQ)  0001711 
IF(CODES( INDEX)-11)     50,64,66  0001712 

64  STACK(TOP)=MOD(IVAL( INDEX )/2**( I Q- 1 ) , 2 ) . EQ. 1  0001713 
GO    TO     110  0001714 

66    STACK(TOP)=MOD( IV AL ( INDEX ) /2**( IQ- 1  )  , 2 ) .EQ.O  0001715 

GO    TO    110  0001716 

70    VALUfc=STACK(TOP)  0001717 

IF     (INDEX-30)    80,90,100  0001718 

80    T0P=T0P-1  0001719 

STACK (TOP )= STACK (TOP). OR. VALUE  00  01720 

GO    TO    110  0001721 

90    T0P=T0P-1  0001722 

STACK ( TOP )= STACK (TOP)  .AND. VALUE  0001723 

GO    TO    110  0001724 

100    STACK( TOP)=.NOT.STACK( TOP)  0001725 

110    CONTINUE  0301726 

IF     (TOP.EQ.l)     GO    TO    120  0001727 

TYPE     220  0001728 

REWIND    INPUT  0001729 

RETURN     1  3001730 

120     IF    (EVAL)    GO    TO     130  0001731 

GO    TO    30  00C1732 

130    CALL    GETPUT(£140,DREC,2)  0001733 

NF0UND=NF0UND+1  0301734 

GO    TO    30  0001735 
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140    TYPE     230,    NRECS.IFILES(NFILES)  0001736 

IF    (NFOUND.GT.O)    GO    TO     150  0001737 

TYPE    240  0001738 

NFILES=NFILES-1  0001739 

GO    TO    160  0001740 

150    TYPE    250t    NFOUND ,F I LE I D  0001741 

160    REWIND    INPUT  0001742 

REWIND    OUTPUT  0001743 

170    RETURN  0001744 

175    RETURN     2  3001745 

180    FORMAT    (•     LOGIC    MUST    BE    SUPPLIED    BEFORE    A  RETRIEVAL    CAN    BE    MADE')    0001746 

190    FORMAT    (•    ENTER    INPUT    FILE    NAME:     »,$)  0001747 

210    FORMAT     (•     ENTER    OUTPUT    FILE    NAME:     •,$)  00C1748 

22C    FORMAT    (•     ERROR    IN    LOGIC    EXPRESSION1)  0001749 

230    FORMAT     (•    ALL',16,'    RECORDS    0FSA6,1    SEARCHED.1)  0001750 

240    FORMAT    <•     THERE    ARE    NO    RECORDS    WHICH    SATISFY    THE    REQUEST')  0001751 

250    FORMAT    (110,'    RECORDS    FOUND    WHICH    SATISFY  THE    REQUEST. •/•    THEY    HAV0001752 

IE    BEEN    STORED    IN     •♦A6)  0001753 

END  0001754 
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SUBROUTINE  NAME:  RLIST 

Purpose:    RLIST   is   used   to   convert   an  unpacked   character 
string   representing   a   list  of   user-entered   numbers    into   a 
corresponding  numeric  list. 
Calling    sequence:     CALL     RLIST  (&n,IMAGE,LIST,NUMC, 

MOST) 
Arguments : 

n — Statement  number  (in  caller)  to  which  a  branch  will  be 
made  if  an  uncorrectable  error  in  the  entered  character 
string  is  detected. 
IMAGE — The   unpacked   character-string  form   of   the   list 

of  numbers. 
LIST — The  list  of  numbers  which  are  returned  in  numeric 

form. 
NUMC— The  number  of  items  in  LIST. 

MOST — The   maximum   number   of   items  that   LIST  may 
contain. 
Subroutines  called:  None 
Common  data  referenced :  None 
Called  by:  DEFLST,  QUIT 

Error  checking  and  reporting:  If  an  illegal  character  (not 
0-9,  dash,  or  comma)  is  detected,  an  error  message  is 
typed  and  the  nonstandard  return  is  taken.  If  the  list  isn't 


composed  of  numbers  or  number  ranges  separated  by  com- 
mas, an  error  message  is  typed,   and  the  nonstandard   re- 
turn is  taken. 
Program  logic:  Each  character  of  the  unpacked  string  is  proc- 
essed via  the  following  transition  matrix : 

0—9  — 


1. 

f(l)/2 

error 

error 

2. 

f(2)/2 

f(3)/l 

f(3)/3 

3. 

f(l)/4 

error 

error 

4. 

f(2)/4 

f(4)/l 

error 

f  (i)  are  defined  as: 

f  ( 1 )  — Start  a  number  value. 

f  (2) — Build  number  value  by  adding  digit  on  right. 

f(3) — Number  built,  add  it  to  list. 

f  (4) — Fill  LIST  with  values  up  to  and  including  current 

value. 
Rows  1  and  2  are  used  to  process  a  single  list  element  or 
the  first  of  a  number-range  pair. 

Rows  3  and  4  are  used  to  process  the  second  of  a  num- 
ber-range pair.  Blanks  are  completely  ignored. 
The  columns  of  the  transition  matrix  are  associated   with 
the  indicated  characters,  and  the  rows  correspond  to  indi- 
vidual states. 
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PROGRAM 


10 


20 

30 
35 

40 

50 

60 


70 


80 


SUBR3UT INE  RLIST(*,  I  MAGE , L I  ST , NUMC  tMCST) 
INTEGER  LIST(l), IM AGE( 30 ) , CHAR< 12 ) ,C0L ( 12 » ,  I MAT  {  4,  3) 
DATA  IMAT/12,22, 14,24,0,31, 0,41,0,33,0 ,0/,IBLNK/'  •/ 
DATA 

DATA  COL/10*!, 2, 3/ 
NUMC=C 
LAST=1 
IP=0 
IR0W=1 
IP=IP+1 

IF  ( I P.GT.30)  GO  TO  120 
ICHAR=IMAGE( IP) 
IF  (ICHAR.EQ.IBLNK )  GO  TO  10 
DO  20  1=1,12 

IF  ( ICHAR.E0.CHAR( I) )  GO  TO  40 
CONTINUE 
TYPE  150,  ICHAR 
RETURN  1 
TYPE  145,IVAL 
GO  TO  30 

IFS=IMAT ( IR0W,C0L( I ) ) 
IF  ( IFS.NE.0)  GO  TO  60 
TYPE  160 
GO  TO  30 
IR0W=M0D( IFS,10) 
IFS=IFS/10 

GO  TO  (70,80,90,100) ,  IFS 
IVAL=  1-1 
GO  TO  10 

I  VAL  =  10*I VAL+I-1 
GO  TO  10 


0001755 
0001756 
0001757 
0001758 
0001759 
0001760 
0001761 
0001762 
0001763 
0001764 
0001765 
0001766 
0001767 
0001768 
0001769 
0001770 
0001771 
0001772 
0001773 
0001774 
0001775 
0001776 
0001777 
0001778 
0001779 
00C1780 
0001781 
0001782 
0001783 
0001784 
0001785 
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90    NUMC=NUMC+1  0001786 

IF     (NUMC. GT.MOST)     GO    TO    110  0001787 

IF( IVAL .GT.MOST )    GO    TO    35  0001788 

LIST (NUMC)=IVAL  00C1789 

GO    TO     (10,140),     LAST  0001790 

100    L  IST(NUMC+1)=LIST(NUMC ) -H  0001791 

NUMC=NUMC+1  0001792 

IF    (NUMC.GT.MOSTI    GO    TO    110  0001793 

IF( IVAL .GT.MOST )    GO    TO    35  0001794 

IF    (LIST(NUMC) .LT. IVAL)    GO    TO    100  0001795 

GO    TO    (10,140),    LAST  0001796 

110    TYPE     170,    MOST  0001797 

NUMC=MOST  0001798 

GO    TO     140  0001799 

120     IF    (NUMC.NE.O)    GO    TO    130  00C1800 

IF     (IPOW.EQ.l)     GO    TO    140  0001801 

NUMC=1  0001802 

LIST(1)=IVAL  0001803 

GO    TO     140  0001804 

130    IF     (M0D( IROW,2) .NE.O)    GO    TO    50  0001805 

LAST=2  0001806 

IROW=IROW/2  0001807 

GO    TO     (90,100),     IROW  0001808 

140    RETURN  0001809 

145    F0RMATU5,'     DOES    NOT    CORRESPOND    TO    A    CATEGORY.     RE-ENTER    NUMBERS*  )    0001810 

150    FORMAT     (IX, Ai,'     IS    AN     ILLEGAL    CHARACTER.    RE-ENTER    NUMBERS.')  0001811 

160    FORMAT    (•     EACH    NUMBER    OR    NUMBER    RANGE     (IE.    4-7)     EXCEPT  ','THE    LAST0001812 

1    MUST    BE    FOLLOWED    BY    A    COMMA. •/•    RE-ENTER    NUMBERS.')  0001813 

170    FORMAT    (•     TOO    MANY     NUMBERS    GIVEN.    ONLY    THE    FIRST', 13,'  WILL    BE    USE0001814 

ID.')  0001815 

END  0001816 
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SUBROUTINE  NAME:  ROWPNT 

Purpose:  ROWPNT  prints  selected  items  or  expressions,  one 

to  a  line,  from  a  selected  file. 
Calling  sequence:  CALL  ROWPNT (&n,NPAGE) 
Arguments : 

n — Statement  (in  caller)  to  which  VLIST  will  branch  when 
an  EOF  is  encountered  by  KEYBRD. 

NPAGE — Number  of  lines  per  page  of  printed  output. 
Subroutines    called:    VLIST,    ACCESS,    GETPUT,    PAUSE, 

EVAL,  UNCODE,  BINTYP,  BLIST 
Common  data  referenced : 

POLISH,  ICODE,  LPS  in  /EXPRNS/ 

ITYPE  in  blank  common 


Called  by:  LIST 

Error  checking  and  reporting :  None 

Program  logic: 

1.  The  list  of  items  to  be  printed  is  obtained  via  a  call  to 
VLIST. 

2.  A  call  to  ACCESS  is  made  to  initialize  the  lookup  of  dic- 
tionary-type items. 

3.  Each  record  of  the  .selected  file  is  obtained  via  GETPUT 
and  a  line  counter  is  incremented  and  tested.  If  it  exceeds 
the  page  size,  a  pause  is  generated  via  PAUSE. 

4.  After  each  record  is  obtained,  the  selected  items  are  evalu- 
ated (if  necessary)  and  printed. 
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SOURCE 


PROGRAM 


SUBROUT INE 
COMMON  NAME 
COMMON  /EXP 
DOUBLE  PREC 
INTEGER  BLA 
i  IC0DE(15,8 
DIMENSION  I 
1  REC(5 

LOGICAL  ERR 
EQUIVALENCE 
DATA  IQUAL/ 
K0UNT=0 
CALL  VLIST( 
IF  (NUM.EQ. 
TYPE  280 
CALL    ACCESS 

120    CALL    GETPUT 
KOUNT=KOUNT 
IF     (KOUNT.L 
K0UNT=0 
CALL    PAUSE! 

130  DO  240  JJ=1 
II=ITEMS( JJ 
IF( II .GT.O) 
II=-I  I 
NAMES I=VNAM 
VAL=EVAL(IP 
IF (ERR »  GO 
GO    TO    150 

135  IVAL=IREC(l 
IF  ( IVAL .EQ 
KIND=ITYPE( 
NAMESI=VNAM 
GO    TO     ( 140, 

140  TYPE  300,  N 
GO    TO     240 

150  TYPE  310,  N 
GO    TO    240 

160  CALL  ACCESS 
TYPE  320,  N 
GO    TO     240 


ROWPNT!*, NPAGE) 

S,ITYPE,IPTS,IPAD 

RNS/    POLISH, ICODE, LPS 

IS  ION    NAMES, LABEL, NAMES I,VNAMES(  20) 

NK, T ANK, I PTS( 500), IQUAL (6), POLISH! 15,8), 

),LPS(  8) 

TYPE(500),    BITEM( 15,25) ,     ITEMS(20),     IREC(500), 

00),     NAMES(500),    TANM25),     LABEL(25),     LISTI25) 

(RECIREC),  (  IVAL,VAL),  (LIST,  TANK),  (BLANK,  IQUAL) 


£270, VN AMES, ITEMS,NUM) 
0)    GO    TO    260 

(I  I , IVAL,TANK,J,1 ) 

(G260,IREC, 1) 

+NUM4-1 

E. NPAGE)    GO    TO    130 

£260) 
,NUM 
) 
GO    TO    135 

ES(JJ) 

EC, I  CODE (1,1  I), POLISH ( 1 ,11) ,LPS(  II  ),ERR) 
TO    240 

I) 

.BLANK)    GO    TO    240 
II  ) 

ES(  JJ) 

150,160,220,170),    KIND 
AMESI ,1 VAL 

AMESI,VAL 

(II, IVAL , TANK, J, 2) 
AMESI, (TANK (  I  ),I  =  1,J) 


0001817 
0001818 
0001819 
0001820 
0001821 
0001822 
0001823 
0001824 
0001825 
0001826 
0001827 
0001828 
0001829 
0001830 
0001831 
0001832 
0001833 
0001834 
0001835 
0001836 
0001837 
0001838 
00C1839 
00C1840 
0001841 
0001842 
0001843 
0001844 
0001845 
0001846 
0001847 
0001848 
00C1849 
0001850 
0001851 
0001852 
0001853 
0001854 
0001855 
0001856 
0001857 
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17C    VAL=HNCODE( VALt IQ)  0001858 

TYPE    310,NAMESI,VAL,  IQUALUQ)  0001859 

GO    TO    240  00C1860 

220    CALL     BINTYP < I I,LABEL,B ITEM,K,M)  0001861 

KOUNT=KOUNT+l  0001862 

TYPE     340,    NAMESI  0001863 

CALL    BL  IST(LIST,NUMS,  IVAL)  0001864 

DO    230    I=1,NUMS  0001865 

KOUNT=KGUNT+l  0001866 

J=LIST(I)  0001867 

230  TYPE  330,  LABEL ( J)  , < B  IT  EMC L , J  ) ,L  =  1 ,K )  0001868 

240  CONTINUE  0001869 

TYPE  290  0001870 

GO  TO  120  0001871 

26C  RETURN  0001872 

270  RETURN  1  0001873 

280  FORMAT  (///>  0001874 

290  FORMAT  ( IX, 3< 8H******** » )  0001375 

30C  FORMAT  <  1  X  ,  A8  ,1  H=,  19  )  0001876 

310  FORMAT  ( IX, A  8 , 1H=, 1PG12 . 5,A1 )  0001877 

320  FORMAT  ( IX, A8 , 1 H=, 12A5/  15X,  12A5)  0001878 

330  FORMAT  (5X,A8,15A4I  0001879 

340  FORMAT  (1X,A8,1H=)  0001880 

END  0001881 
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SUBROUTINE  NAME:  SCAN 

Purpose:    This    subroutine    is   used    to    set   character-position 

pointers   for  the   syntactic  elements  of  a  condition    (name, 

relation,  value  (s) )  or  a  logical  expression. 
Calling  sequence:   CALL   SCAN(&n,IMAGE,IS,Il,I2,IT) 
Arguments : 

n — Statement    number     (in    calling    routine)     to    which    a 
branch  will  be  made  if  IMAGE  is  all  blanks. 

IMAGE — String  of  unpacked  left- justified  characters. 

IS — Starting  position  of  the  scan. 

II — Pointer  to  first  character  of  syntactic  element. 

12 — Pointer  to  last  character  of  syntactic  element. 

IT — Embedded  blank  switch. 


Subroutines  called:  None 
Common  data  referenced:  None 
Called  by:  RELEXP,  LOGEXP 
Error  checking  and  reporting :  None 
Program  logic: 

1.  The  position  of  the  first  nonblank  character  is  determined. 

2.  If  all  characters  after  the  IS'th  are  blank,  the  nonstandard 
return  is  taken. 

3.  If  no  embedded  blanks  are  permitted  (IT=1),  the  position 
of  the  last  nonblank  character  to  the  right  of  the  position 
found  in  step  1  is  determined,  and  control  passes  to  the  caller. 

4.  Otherwise  (if,  IT=2),  the  position  of  the  first  nonblank 
character  to  the  left  of  position  80  is  determined  and  control 
returns  to  the  caller. 
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5 

6 

10 


11 


SUBROUTINE    SCAN{*,  IMAGE, IS,  II, 12, IT) 

INTEGER    IMAGEtl) 

DATA     IBLNK/'     •/ 

DO    1     I=IS,80 

IFUMAGEU  I  .NE.  IBLNK)  GO  TO  2 

CONTINUE 

RETURN  1 

I  1=1 

J=  11  +  1 

GO  TO  (3,10), IT 

DO  4  I2=J,80 

IF<  IMAGE(  12). EQ. IBLNK)  GO  TO  5 

CONTINUE 

12=81 

12=12-1 

RETURN 

DO  11  I=J,80 

I2  =  80-H-J 

IF( IMAGE(I2).NE. IBLNK)  GO  TO  6 

CONTINUE 

GO  TO  6 

END 


0001882 
0C01883 
0001884 
0001885 
0001886 
0001887 
00C1888 
0001889 
0001890 
0001891 
0001892 
0001893 
00C1894 
0001895 
0001896 
0001897 
00C1898 
0001899 
0001900 
0001901 
0001902 
0001903 
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SUBROUTINE  NAME:  START 

Purpose:    START   determines   availability  of  data  bases  and 

their  associated  fdes. 
Calling  sequence:  CALL  START 
Arguments :  None 
Subroutine  called:  IFILE 
Common  data  referenced: 

All  variables  in  /FILNAM/  except  NUMF 


Called  by:  DRIVER 

Error  checking  and  reporting:  None 

Program  logic: 

1.  The   name   GFILE    is   associated   with   FORTRAN   input 
unit  20. 

2.  A  welcoming  message  is  typed  and  records  of  GFILE  are 
read  to  fill  the  /FILNAM/  common  area. 

3.  As  each  record  is  read,  parts  of  it  are  output  to  the  termi- 
nal. 
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SOURCE 


PROGRAM 


SUBROUT  IN 
COMMON  /F 
DOUBLE  PR 
INTEGER  M 
CALL  IF  IL 
NUMF=1 
TYPE    1 

10  READ( 20tl 
1    DEFTMNU 

TYPE  12, M 
NUMF=NUMF 
GO  TO  10 
20  NUMF=NUMF 
REWIND  20 
TYPE  2 
RETURN 

1  FORMAT!/' 
1    •     AT    THE 

2  F0RMAT(/' 

1  •    THE    "F 

2  ■     BASE    0 

11  F0RMATU5 

12  FORMATl/l 
END 


E    START 

ILNAM/    MASTER,MASK,DEFTN,DFILE,BFILE,NUMF,NUMI, ID  I  MS 

ECISI0N    C0NTNT(4) 

ASTER(4)  ,MASK(4),DEFTN(4)  ,DF  ILE  <  4) ,  BFI  L  E  (  4)  ,  ID  IMS(  4) 

E( 20, 'GFILE'  ) 


i,END=20)     MASTER (NUMF) ,C0NTNT , MASK (NUMF ) , 
MF),DFILE (NUMF ) , BFI L E ( NUMF ) , I DIMS(  NUMF ) 
ASTER(NUMF)  »C0NTNT 
+  1 


-1 


WELCOME    TO    THE    USGS    GRASP    RETRIEVAL    SYSTEM.*/ 

CURRENT    TIME    THE    FOLLOWING    DATA    BASES    ARE    AVAILABLE:1) 

BEFORE    ANY    OF    THESE    DATA    BASES    MAY    BE    ACCESSED,'/ 

ILE"    COMMAND    SHOULD    BE    USED    TO    IDENTIFY    THE    DATA', 

F  INTEREST.') 

,1 X,4A10,4( IX, A5) ,14) 

X,A6,'-  «,4A10) 


0001904 
0001905 
0001906 
0001907 
0001908 
0001909 
0001910 
0001911 
D001912 
0001913 
0001914 
0001915 
0001916 
0001917 
0001918 
0001919 
0001920 
0001921 
0001922 
0001923 
0001924 
0001925 
0001926 
0001927 


GRASP  SOFTWARE  SPECIFICATIONS 


85 


FUNCTION  NAME:  UNCODE 

Purpose:  UNCODE  breaks  down  each  qualified  real  value  into 

a  real  value  and  a  qualifier  code. 
Calling  sequence:   VALUE  =  UNCODE(VAL,ID) 

Arguments : 

VAL — Packed  value  and  qualifier. 

ID — Encoding  of  qualifier  value. 
Subroutines  called:  None 


Common  data  referenced:  None 

Called  by:  COLPNT,  DUMPIT,  FIT,  MEAN,  RETRVE, 
ROWPNT,  EVAL 

Error  checking  and  reporting:  None 

Program  logic:  The  type  REAL  argument  VAL  may  be  visual- 
ized as  composed  of  both  whole  and  fractional  parts.  ID  is 
set  to  the  3  low-order  bits  of  the  whole  part.  The  whole  part 
is  then  shifted  right  3  bits,  and  the  result  is  added  to  the 
fractional  part  to  form  the  value  returned  by  the  function. 
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PROGRAM 


FUNCTION    UNCODE(VAL, ID) 

RSIGN=SIGN( 1.0, VAL) 

VAL=ABS(VAL  ) 

IPART=VAL 

REST=VAL-IPART 

ID=M0D( IPART, 8) 

UNCODE=RSIGN*( ( I  PART/8 ) +REST ) 

RETURN 

END 


0001928 
0001929 
0001930 
0001931 
0001932 
0001933 
0001934 
0001935 
0001936 
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SUBROUTINE  NAME:  VLIST 

Purpose:  VLIST  prompts  for  and  accepts  (via  KEYBRD)  a 
set  of  item  names  or  arithmetic  expressions  that  will  be 
printed  by  the  caller.  The  user  is  provided  the  ability  to  reuse 
the  list  that  was  last  entered. 

Calling  sequence:   CALL   VLIST (&m,VNAMES,LIST,N) 

Arguments : 

m — Statement  number  (in  caller)  to  which  a  branch  will  be 
made  if  an  EOF  is  sensed  by  KEYBRD. 

VNAMES — List  of  item  names  to  be  printed. 

LIST — Item  numbers  corresponding  to  VNAMES. 

N— Number  of  elements  in  VNAMES  and  LIST. 
Subroutines    called:    KEYBRD,    SCAN,    BFIND,    PREVAL, 

PACK 
Common  data  referenced: 

NAMES,  PNTS,  IDIM  in  blank  common 
Called  by:  BDEF,  COLPNT,  ROWPNT 
Error  checking  and  reporting:  None 
Program  logic: 
1.    The  user  is  asked  if  he  wishes  to  enter  a  new  list  of  item 


names.  If  not,  the  values  of  the  arguments  as  set  by  a  pre- 
vious call  are  returned.  Otherwise,  a  new  list  is  processed 
as  below. 

2.  The  routine  requests  the  user  to  enter  a  set  of  item  names 
or  expressions.  Each  entry  is  processed  as  specified  below 
until  a  blank  entry  is  detected.  Control  is  then  returned  to 
the  caller. 

3.  An  entry  is  accepted  via  KEYBRD,  and  leading  and/or 
trailing  blanks  are  eliminated  via  SCAN. 

4.  If  the  entry  length  is  greater  than  seven  characters,  an 
expression  is  assumed.  If  the  entry  is  not  found  to  be  an 
item  name   (via  BFIND),  an  expression  is  assumed. 

5.  If  the  entry  is  determined  to  be  an  item  name,  that  name 
is  stored  in  VNAMES,  and  the  corresponding  item  number 
is  stored  in  LIST. 

6.  If  the  entry  is  an  expression,  a  call  to  PREVAL  is  made 
to  parse  it  into  Reverse-Polish  form  for  later  evaluation. 
KNT  points  to  the  Reverse-Polish  form  (stored  in  /EXPNS/ 
by  PREVAL) ,  and  the  negative  of  KNT  is  returned  in  LIST. 

7.  The  values  of  the  arguments  are  saved  for  future  calls  if 
required. 
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SUBROUTINE    VLIST(*  , VNAME S ,L I  ST ,N) 
COMMON    NAMEStTYPE, PNTS, IDIM 

DOUBLE    PRECISION    NAMES < 500 ), NAME , BLANK, VNAMES < 1 ), VSAV E (2C ) 
INTEGER    PNTS(500),TYPE( 500),LIST( 1) ,EXPR( 80 ) ,HAL VE S( 2 ) ,EXPHDG(2C 
1     ,LSAVE(20) 
EQUIVALENCE     ( HA LVE S ( 1) , NAME ) 
DATA    IEQUAL , BLANK/ •=», •  • /, MS AVE,N0/0, *N» / 


•  _  • 


10 


30 


l.» 

IF(NSAVE.EQ.O)    GO    TO    5 

TYPE    4 

CALL    KEYBRDU110,  I,  1) 

IF( I.NE.N0)    GO    TO    5 

N=NSAVE 

DO    6     I=1,NSAVE 

LISTU  )=LSAVE(  I  ) 

VNAMES(  I  )  =  VSAVE(  I  I 

GO    TO     130 

N=0 

KNT=0 

TYPE    120 

N=N  +  1 

TYPE     140,    EXPHDG(N) 

CALL    KEYBRD(&11G,EXPR,  80) 

CALL    SCAN(6115,EXPR,1,L1,L,2) 

IF(L-L1.GT.6)    GO    TO    60 

L2=Ll+6 

NAME=BLANK 

CALL    PACK(EXPR(L1)  , NAME ,L2-L 1  +  1 ,  8) 

CALL    BFIND( £60, NAME,  I, NAMES, PNTS, IDIM) 

VNAMES(N) =NAME 

LIST(N)=I 

IF     (N.E0.20)     RETURN 

GO    TO    10 


•20. •/ 


0001937 
0001938 
0001939 

)  0001940 
0001941 
0001942 
0001943 

110001944 
0001945 
0001946 
0001947 
3001948 
0001949 
0001950 
0001951 
0001952 
0001953 
0001954 
0001955 
0001956 
0001957 
0001958 
0001959 
0001960 
0001961 
0001962 
0001963 
0001964 
0001965 
0001966 
0001967 
0001968 
00C1969 
0001970 


GRASP  SOFTWARE  SPECIFICATIONS  gy 

60    IF    (KNT.EQ.8)    RETURN  nnmo-,* 

NAME=BLANK  0001971 

DO    70    K=l,10  0001972 

IF     <EXPR(K«-L1-1).EQ.IEQUAL)    GO    TO    80  nnr\Zll 

70    CONTINUE  0001974 

K=1  0001975 

HALVES(2)=EXPHDG(N)  2??1976 

GO    TO    90  000197.7 

80    J=MIN0(K-lf 7J+L1-1  0001978 

CALL^PACKIEXPRCLll.NAME.J    -Ll*l,8>  SSSJSSS 

90    CALL    PREVALU100,EXPR(K+L1-1),L,KNTI  Innilil 

I=-KNT  UUUIVH^ 

GO    TO    30  0001983 

100    N=N-1  0001984 

GO    TO    10  0001985 

110    RETURN    1  0001986 

115  N=N-1  0001987 
NSAVE=N  0001988 
DO  116  I=1,NSAVE  nnnioon 
LSAVEdl-LISTIII  °™    ??? 

116  VSAVE(I)=VNAMES(I)  J°?!i:J 
130    RETURN  0001992 

4    FORM  ATM     DO    YOU    WISH    TO    ENTER    A    NEW    LIST    OF    NAMES    OR*  ,  0001994 

1     •    EXPRESSIONS?     (VES    OR    NO):     •,$>  oomllt 

120    FORMAT    <•    ENTER    THE    NAMES    OF     ITEMS    OR    THE    EXPRESSIONS     ',  0001996 

l'WHICH   YOU    WANT    PRINTED.')  nnmoo? 

140    FORMAT    <1X,A4,S,  J001997 

0001999 


r 


AREA 
CEi 


